home *** CD-ROM | disk | FTP | other *** search
/ BMUG Revelations / BMUG Revelations.toast / Utilities / Network / Asynchronous Networking / ULACS.inc1.p < prev    next >
Text File  |  1990-12-21  |  95KB  |  3,415 lines

  1. {$P}
  2. { ULACS.inc1.p }
  3. { Copyright © 1988 - 1990 Apple Computer, Inc.    All rights reserved. }
  4.  
  5. var
  6.  
  7. gAboutWindow: TWindow;            { About box window. }
  8. gPssster: TPssst;                        { About box animation object. }
  9. gADSP: integer;                        { Driver number for ADSP. }
  10.  
  11. {--------------------------------------------------------------------------------------------------}
  12.  
  13. {$S ARes}
  14.  
  15. function GetNow: longInt;
  16.     { Return the current time (in seconds since 1904). }
  17.  
  18.     var l: longInt;
  19.  
  20.     begin
  21.         GetDateTime(l);
  22.         GetNow := l;
  23.     end;
  24.  
  25. function Expired(d: longInt): boolean;
  26.     { Return true if this message is expired. Consider it expired also if it's positive or -1. Positive means
  27.         an expiration date earlier than 1968, which doesn't make sense any more, and eliminating them
  28.         avoids signed comparison problems. -1 used to be used for "kill" messages, but we've taken this
  29.         feature out, and this eliminates any old kill messages still floating around. }
  30.  
  31.     begin
  32.         Expired := (d >= -1) or (d <= GetNow);
  33.     end;
  34.  
  35. {--------------------------------------------------------------------------------------------------}
  36.  
  37. {$S ARes}
  38.  
  39. function LongAsString(l: longInt): Str255;
  40.     { Convert a long into a string. }
  41.  
  42.     var s: Str255;
  43.  
  44.     begin
  45.         NumToString(l,s);
  46.         LongAsString := s;
  47.     end;
  48.  
  49. function BoolAsString(b: boolean): Str255;
  50.     { Convert a boolean into a string. }
  51.  
  52.     begin
  53.         if b then BoolAsString := 'true'
  54.         else BoolAsString := 'false';
  55.     end;
  56.  
  57. {--------------------------------------------------------------------------------------------------}
  58.  
  59. {$S ARes}
  60.  
  61. procedure PutNextString(var p: Ptr; var sz: longInt; s: Str255);
  62.     { Store a string into a buffer, and append a tab (field separator). Increment the pointer and size as we go.
  63.         Note: the buffer must be large enough to hold the string without overflowing. }
  64.  
  65.     begin
  66.         BlockMove(Ptr(ord4(@s)+1),p,length(s));
  67.         p := Ptr(ord4(p)+length(s));
  68.         p^ := kTab;
  69.         p := Ptr(ord4(p)+1);
  70.         sz := sz + length(s) + 1;
  71.     end;
  72.  
  73. procedure PutNextHandle(var p: Ptr; var sz: longInt; h: Handle);
  74.     { Store a handle into a buffer, and append a tab (field separator). Increment the pointer and size as we go.
  75.         Note: the buffer must be large enough to hold the string without overflowing. }
  76.  
  77.     var l: longInt;
  78.  
  79.     begin
  80.         l := GetHandleSize(h);
  81.         BlockMove(h^,p,l);
  82.         p := Ptr(ord4(p)+l);
  83.         p^ := kTab;
  84.         p := Ptr(ord4(p)+1);
  85.         sz := sz + l + 1;
  86.     end;
  87.  
  88. {--------------------------------------------------------------------------------------------------}
  89.  
  90. {$S ARes}
  91.  
  92. function BuildPull(p: Ptr): longInt;
  93.     { Creat a pull command in the buffer pointed to by p. }
  94.  
  95.     var sz: longInt;
  96.  
  97.     begin
  98.         sz := 0;
  99.         PutNextString(p,sz,'Pull');
  100.         p^ := kReturn;
  101.         sz := sz+1;
  102.         BuildPull := sz;
  103.     end;
  104.  
  105. function BuildPullCold(p: Ptr): longInt;
  106.     { Creat a pull cold command in the buffer pointed to by p. }
  107.  
  108.     var sz: longInt;
  109.  
  110.     begin
  111.         sz := 0;
  112.         PutNextString(p,sz,'PullCold');
  113.         p^ := kReturn;
  114.         sz := sz+1;
  115.         BuildPullCold := sz;
  116.     end;
  117.  
  118. {--------------------------------------------------------------------------------------------------}
  119.  
  120. {$S ARes}
  121.  
  122. function TLACSApplication.DoMakeDocument(itsCmdNumber: CmdNumber): TDocument;
  123.     { Make a new document. }
  124.  
  125.     var messagesDoc: TLACSDocument;
  126.  
  127.     begin
  128.         New(messagesDoc);
  129.         FailNil(messagesDoc);
  130.         messagesDoc.ILACSDocument;
  131.         DoMakeDocument := messagesDoc;
  132.     end;
  133.  
  134. {--------------------------------------------------------------------------------------------------}
  135. {$S ARes}
  136.  
  137. function TLACSApplication.DoMenuCommand(aCmdNumber: CmdNumber): TCommand;
  138.     { Handle menu commands. }
  139.  
  140.     var f: AppFile;
  141.         fInfo: FInfo;
  142.         ignore: OSErr;
  143.  
  144.     procedure saveOne(d: TDocument);
  145.         { Save a document. }
  146.  
  147.         begin
  148.             d.Save(cSave,false,false);
  149.         end;
  150.  
  151.     begin
  152.         DoMenuCommand := nil;
  153.         { Check if we should pass the command on to the document (this is in case all windows are closed). }
  154.         if (aCmdNumber in
  155.                 [cMessagesWindow,cNewWindow,cStatusWindow,cMarkAllRead,cClearMessages,cPreferences])
  156.                 and (gDocList.fSize > 0) then
  157.             DoMenuCommand := TDocument(gDocList.At(1)).DoMenuCommand(aCmdNumber)
  158.  
  159.         { Otherwise, handle it locally if it's one of ours. }
  160.         else case aCmdNumber of
  161.  
  162.             cAboutApp:
  163.                 begin
  164.                     { Display the About... window and bring it to the front. }
  165.                     gAboutWindow.Show(true,true);
  166.                     gAboutWindow.Select;
  167.                 end;
  168.  
  169.             cFinderNew:
  170.                 begin
  171.                     { Just started up. Make sure the settings file is there and ready for us. }
  172.                     f.vRefnum := gConfiguration.sysVRefNum;
  173.                     f.fName := GetString(kSettingsFileSTR)^^;
  174.                     if GetFInfo(f.fName,f.vRefnum,fInfo) <> noErr then
  175.                         begin
  176.                             { File not there, or weird in some way. Thwack it, and create a new one. }
  177.                             ignore := FSDelete(f.fName,f.vRefnum);
  178.                             ignore := Create(f.fName,f.vRefnum,kSignature,kLACSSettings);
  179.                         end;
  180.                     { Open the settings file (DoRead'll take care of default values if the file was just created). }
  181.                     OpenOld(cOpen,f);
  182.                 end;
  183.  
  184.             cQuit:
  185.                 begin
  186.                     { Make sure we save everything first. }
  187.                     gDocList.Each(saveOne);
  188.                     { Then let MacApp do it's normal quit stuff. }
  189.                     DoMenuCommand := inherited DoMenuCommand(aCmdNumber);
  190.                 end;
  191.  
  192.             { If it's not ours, let someone else handle it. }
  193.             otherwise DoMenuCommand := inherited DoMenuCommand(aCmdNumber);
  194.             end;
  195.     end;
  196.  
  197. {--------------------------------------------------------------------------------------------------}
  198. {$S ARes}
  199.  
  200. procedure TLACSApplication.DoSetupMenus;
  201.     { Enable the appropriate menus. }
  202.  
  203.     begin
  204.         inherited DoSetupMenus;
  205.         Enable(cAboutApp,true);
  206.         { We need this just in case all the windows are closed. }
  207.         if gDocList.fSize > 0 then
  208.             begin
  209.                 Enable(cMessagesWindow,true);
  210.                 Enable(cNewWindow,true);
  211.                 Enable(cStatusWindow,true);
  212.                 Enable(cMarkAllRead,true);
  213.                 Enable(cClearMessages,true);
  214.                 Enable(cPreferences,true);
  215.             end;
  216.     end;
  217.  
  218. {--------------------------------------------------------------------------------------------------}
  219.  
  220. {$S AFields}
  221.  
  222. procedure TLACSApplication.Fields(procedure DoToField(fieldName: Str255; fieldAddr: Ptr;
  223.                                     fieldType: integer));
  224.  
  225.     begin
  226.         DoToField('TLACSApplication', nil, bClass);
  227.         DoToField('gAboutWindow', @gAboutWindow, bObject);
  228.         DoToField('gPssster', @gPssster, bObject);
  229.         DoToField('gADSP', @gADSP, bInteger);
  230.         inherited Fields(DoToField);
  231.     end;
  232.  
  233. {--------------------------------------------------------------------------------------------------}
  234.  
  235. {$S AFree}
  236.  
  237. procedure TLACSApplication.Free;
  238.  
  239.     begin
  240.         { Free our periodic object that updates the "psssts"s. }
  241.         gPssster.Free;
  242.         inherited Free;
  243.     end;
  244.  
  245. {--------------------------------------------------------------------------------------------------}
  246.  
  247. {$S AInit}
  248.  
  249. procedure TLACSApplication.ILACSApplication(itsMainFileType: OSType);
  250.  
  251.     var i: integer;
  252.  
  253.     begin
  254.         IApplication(itsMainFileType);
  255.  
  256.         { Init the random number generator. }
  257.         GetDateTime(randSeed);
  258.  
  259.         { Set up the about box. }
  260.         new(gPssster);
  261.         FailNil(gPssster);
  262.         gPssster.IPeriodic(kPssstInitial,kPssstInactive,kPssstActive);
  263.  
  264.         { Init the network. }
  265.         if gConfiguration.atDrvrVersNum < 53 then        { Check for AppleTalk phase 2. }
  266.             begin
  267.                 StdAlert(phNoPhase2);
  268.                 ExitMacApp;
  269.             end;
  270.         FailOSErr(OpenDriver('.MPP',i));
  271.         if OpenDriver('.DSP',gADSP) <> noErr then
  272.             begin
  273.                 StdAlert(phNoADSP);
  274.                 ExitMacApp;
  275.             end;
  276.  
  277.         { Set up the about box window. }
  278.         gAboutWindow := NewTemplateWindow(kAboutWindow,nil);
  279.  
  280.         { Suppress dead-stripping of the following classes }
  281.         if gDeadStripSuppression then
  282.             begin
  283.                 if Member(TObject(nil), TMessagesWindow) then;
  284.                 if Member(TObject(nil), TNewWindow) then;
  285.                 if Member(TObject(nil), TStatusWindow) then;
  286.                 if Member(TObject(nil), TWindow) then;
  287.                 if Member(TObject(nil), TMessageListView) then;
  288.             end;
  289.     end;
  290.  
  291. {--------------------------------------------------------------------------------------------------}
  292. {$S ARes}
  293.  
  294. procedure TLACSApplication.Terminate;
  295.     { Clean up when application is terminated. }
  296.  
  297.     begin
  298.         { Free all the documents. This is important since it'll force the net stuff to shut down. }
  299.         gDocList.FreeAll;
  300.         inherited Terminate;
  301.     end;
  302.  
  303. {--------------------------------------------------------------------------------------------------}
  304. {$S ARes}
  305.  
  306. procedure TLACSDocument.CheckFreeSpace;
  307.     { Check the amount of free space available in memory, and free messages if necessary to make room. }
  308.  
  309.     var hRes: Handle;
  310.  
  311.     begin
  312.         { Allocate our buffer zone. }
  313.         hRes := NewHandle(kOurMemReserve);
  314.         FailNil(hRes);
  315.         { Free messages until we're down to safe(r) levels. }
  316.         while MemSpaceIsLow and (fMessages.fSize > 0) do fMessages.At(1).Free;
  317.         { Dispose of the buffer area. }
  318.         DisposHandle(hRes);
  319.     end;
  320.  
  321. {--------------------------------------------------------------------------------------------------}
  322.  
  323. {$S AClose}
  324.  
  325. procedure TLACSDocument.CloseView(aView: TView);
  326.     { Close a window in the document. }
  327.  
  328.     begin
  329.         { Ensure we close the window without closing the document. }
  330.         if aView.fDocument = self then aView.Close;
  331.     end;
  332.  
  333. {--------------------------------------------------------------------------------------------------}
  334.  
  335. {$S AOpen}
  336.  
  337. procedure TLACSDocument.DoInitialState;
  338.         { Set up the initial state of the document. }
  339.  
  340.     begin
  341.         with fConfig do
  342.             begin
  343.                 { These are the default algorithm parameters. }
  344.                 inZoneSearch := 2;
  345.                 push := true;
  346.                 pull := false;
  347.                 pullOnLess := 5;
  348.                 count := true;
  349.                 countValue := 30;
  350.                 feedback := true;
  351.                 delayBase := 5;
  352.                 delayExp := 2;
  353.                 expireIn := 345600;        { 60*60*24*4 (four days) }
  354.                 defaultFilter := kNormalFilter;
  355.                 defaultType := kNormalType;
  356.                 forwarding := kForwardManually;
  357.                 signature := kSignatureFromChooser;
  358.                 userSignature := '';
  359.             end;
  360.         fUseDisplayState := false;
  361.     end;
  362.  
  363. {--------------------------------------------------------------------------------------------------}
  364.  
  365. {$S AOpen}
  366.  
  367. procedure TLACSDocument.DoMakeViews(forPrinting: boolean);
  368.     { Create views to display the document. }
  369.  
  370.     var p: Point;
  371.         ds: TDocumentSaver;
  372.         re: TMessagesExpirator;
  373.         zl: TZoneLookup;
  374.         nl: TNodeLookup;
  375.         g: TGossip;
  376.  
  377.     begin
  378.         { Actually, we use this method mainly to start up the periodic functions. This isn't very MacAppish, but...
  379.             We need to have the windows around when reading in the document since we store some things
  380.             (like the total messages seen count) directly in fields in the window, but we don't want to have
  381.             periodic stuff going until everything else is fully set up. }
  382.  
  383.         { Document saver. }
  384.         new(ds);
  385.         FailNil(ds);
  386.         ds.IDocumentSaver(self,kDocSaverInitial,kDocSaverInactive,kDocSaverActive);
  387.         fDocumentSaver := ds;
  388.  
  389.         { Messages expirer. }
  390.         new(re);
  391.         FailNil(re);
  392.         re.IMessagesExpirator(self,kExpirerInitial,kExpirerInactive,kExpirerActive);
  393.         fMessagesExpirator := re;
  394.  
  395.         { Zone lookup. }
  396.         new(zl);
  397.         FailNil(zl);
  398.         zl.IZoneLookup(self,kZoneLookupInitial,kZoneLookupInactive,kZoneLookupActive);
  399.         fZoneLooker := zl;
  400.  
  401.         { Node lookup. }
  402.         new(nl);
  403.         FailNil(nl);
  404.         nl.INodeLookup(self,kNodeLookupInitial,kNodeLookupFastInactive,kNodeLookupSlowInactive,kNodeLookupActive);
  405.         fNodeLooker := nl;
  406.  
  407.         { Gossipee. }
  408.         new(g);
  409.         FailNil(g);
  410.         g.IGossip(self,false,kGossipeeInitial,kGossipeeInactive,kGossipeeActive);
  411.         fGossipee := g;
  412.  
  413.         { Gossiper. }
  414.         new(g);
  415.         FailNil(g);
  416.         g.IGossip(self,true,kGossiperInitial,kGossiperInactive,kGossiperActive);
  417.         fGossiper := g;
  418.  
  419.         { Set up windows according to the saved state. }
  420.         if fUseDisplayState then
  421.             begin
  422.                 p := fDisplayState.messagesWindPos;
  423.                 fMessagesWindow.Locate(p.h,p.v,false);
  424.                 fMessagesWindow.fNotify.SetState(fDisplayState.notifyOnNew,false);
  425.                 p := fDisplayState.newWindPos;
  426.                 fNewWindow.Locate(p.h,p.v,false);
  427.                 p := fDisplayState.statusWindPos;
  428.                 fStatusWindow.Locate(p.h,p.v,false);
  429.                 fStatusWindow.IncTotalMessages(fDisplayState.totalMessages);
  430.                 fStatusWindow.IncTotalPassed(fDisplayState.passedMessages);
  431.             end;
  432.  
  433.         { Clear out any expired messages. }
  434.         fNewWindow.ResetExpire;
  435.  
  436.         { Start out bored. }
  437.         fStatusWindow.Bored;
  438.     end;
  439.  
  440. {--------------------------------------------------------------------------------------------------}
  441.  
  442. {$S ARes}
  443.  
  444. function TLACSDocument.DoMenuCommand(aCmdNumber: CmdNumber): TCommand;
  445.     { Handle menu commands. }
  446.  
  447.     begin
  448.         DoMenuCommand := nil;
  449.         { We only handle items in our menu. }
  450.         case aCmdNumber of
  451.  
  452.             cMessagesWindow:
  453.                 begin
  454.                     { Select it and bring it to the front. }
  455.                     fMessagesWindow.Show(true,true);
  456.                     fMessagesWindow.Select;
  457.                 end;
  458.  
  459.             cNewWindow:
  460.                 begin
  461.                     { Select it and bring it to the front. }
  462.                     fNewWindow.Show(true,true);
  463.                     fNewWindow.Select;
  464.                 end;
  465.  
  466.             cStatusWindow:
  467.                 begin
  468.                     { Select it and bring it to the front. }
  469.                     fStatusWindow.Show(true,true);
  470.                     fStatusWindow.Select;
  471.                 end;
  472.  
  473.             cMarkAllRead:
  474.                 begin
  475.                     { Clear the current message display. }
  476.                     fMessagesWindow.ClearCurrent;
  477.                     { Then mark everything as read. }
  478.                     MarkAllAsRead;
  479.                 end;
  480.  
  481.             cClearMessages:
  482.                 begin
  483.                     { Clear the current message display. }
  484.                     fMessagesWindow.ClearCurrent;
  485.                     { Then delete all the messages. }
  486.                     fMessages.FreeAll;
  487.                 end;
  488.  
  489.             cPreferences:
  490.                 begin
  491.                     { Find out what the user would like as defaults. }
  492.                     GetPreferences;
  493.                 end;
  494.  
  495.             { If it's not ours, let someone else handle it. }
  496.             otherwise DoMenuCommand := inherited DoMenuCommand(aCmdNumber);
  497.             end;
  498.     end;
  499.  
  500. {--------------------------------------------------------------------------------------------------}
  501.  
  502. {$S AWriteFile}
  503.  
  504. procedure TLACSDocument.DoNeedDiskSpace(var dataForkBytes, rsrcForkBytes: longInt);
  505.     { Computer how much disk space is needed to save the document to disk. }
  506.  
  507.     procedure addInOne(r: TMessage);
  508.         { Compute the space for one message. }
  509.  
  510.         begin
  511.             r.DoNeedDiskSpace(dataForkBytes,rsrcForkBytes);
  512.         end;
  513.  
  514.     begin
  515.         inherited DoNeedDiskSpace(dataForkBytes,rsrcForkBytes);
  516.         dataForkBytes := dataForkBytes + sizeof(longInt) + sizeof(DisplayState) + sizeof(ConfigSettings) +
  517.                                     sizeof(longInt) + fMessages.fSize;
  518.         fMessages.Each(addInOne);
  519.     end;
  520.  
  521. {--------------------------------------------------------------------------------------------------}
  522.  
  523. {$S AReadFile}
  524.  
  525. procedure TLACSDocument.DoRead(aRefNum: integer; rsrcExists, forPrinting: boolean);
  526.     { Read the document from disk. }
  527.  
  528.     var dispRec: DisplayState;
  529.         fileFormat: longInt;
  530.         errRet: OSErr;
  531.         nr: TMessage;
  532.         l: longInt;
  533.         n: longInt;
  534.         i: longInt;
  535.         s: longInt;
  536.         h: Handle;
  537.         config: ConfigSettings;
  538.  
  539.     begin
  540.         { Get the file size. }
  541.         FailOSErr(GetEOF(aRefNum,l));
  542.         { If it's zero, don't try to read it. }
  543.         if l = 0 then errRet := -1
  544.         else
  545.             begin
  546.                 { Otherwise, check the file format. }
  547.                 l := sizeof(fileFormat);
  548.                 errRet := FSRead(aRefNum,l,@fileFormat);
  549.                 if (errRet = noErr) and (fileFormat <> kSettingsVersion) then
  550.                     begin
  551.                         { If it's not what we're willing to parse, ask if we can erase it. }
  552.                         if MacAppAlert(phInvalidSettings,nil) <> kYesButton then Failure(-1,0);
  553.                         errRet := -1;
  554.                     end;
  555.             end;
  556.         { If we don't have a good settings file, initialize from scratch. }
  557.         if errRet <> noErr then
  558.             begin
  559.                 { Show the disclaimers. }
  560.                 StdAlert(phLegal);
  561.                 DoInitialState;
  562.             end
  563.         { Otherwise, read it in from the file. }
  564.         else
  565.             begin
  566.                 inherited DoRead(aRefNum,rsrcExists,forPrinting);
  567.                 { Read the display state. }
  568.                 l := sizeof(dispRec);
  569.                 FailOSErr(FSRead(aRefNum,l,@dispRec));
  570.                 fDisplayState := dispRec;
  571.                 fUseDisplayState := true;
  572.                 { Read the configuration. }
  573.                 l := sizeof(config);
  574.                 FailOSErr(FSRead(aRefNum,l,@config));
  575.                 fConfig := config;
  576.                 { Read each of the messages. }
  577.                 l := sizeof(n);
  578.                 FailOSErr(FSRead(aRefNum,l,@n));
  579.                 for i := 1 to n do
  580.                     begin
  581.                         new(nr);
  582.                         FailNil(nr);
  583.                         nr.IMessageFromFile(self,aRefNum);
  584.                     end;
  585.             end;
  586.  
  587.         { Now expire any messages that need it. }
  588.         ExpireMessages;
  589.     end;
  590.  
  591. {--------------------------------------------------------------------------------------------------}
  592.  
  593. {$S ARes}
  594.  
  595. procedure TLACSDocument.DoSetupMenus;
  596.     { Enable the appropriate menus. }
  597.  
  598.     begin
  599.         inherited DoSetupMenus;
  600.         Enable(cMessagesWindow,true);
  601.         Enable(cNewWindow,true);
  602.         Enable(cStatusWindow,true);
  603.         Enable(cMarkAllRead,true);
  604.         Enable(cClearMessages,true);
  605.         Enable(cPreferences,true);
  606.     end;
  607.  
  608. {--------------------------------------------------------------------------------------------------}
  609.  
  610. {$S AWriteFile}
  611.  
  612. procedure TLACSDocument.DoWrite(aRefNum: integer; makingCopy: boolean);
  613.     { Write the document to disk. }
  614.  
  615.     var dispRec: DisplayState;
  616.         fileFormat: longInt;
  617.         errRet: OSErr;
  618.         sr: SavedMessage;
  619.         l: longInt;
  620.         n: longInt;
  621.         i: longInt;
  622.         s: longInt;
  623.         h: Handle;
  624.         r: Rect;
  625.         config: ConfigSettings;
  626.  
  627.     procedure saveOne(r: TMessage);
  628.         { Write one message to disk. }
  629.  
  630.         begin
  631.             r.WriteToFile(aRefNum);
  632.         end;
  633.  
  634.     begin
  635.         { Write file format. }
  636.         fileFormat := kSettingsVersion;
  637.         l := sizeof(fileFormat);
  638.         FailOSErr(FSWrite(aRefNum,l,@fileFormat));
  639.         inherited DoWrite(aRefNum,makingCopy);
  640.         { Figure out the display state. }
  641.         with dispRec do
  642.             begin
  643.                 fMessagesWindow.GetGlobalBounds(r);
  644.                 messagesWindPos := r.topLeft;
  645.                 messagesWindShown := fMessagesWindow.IsShown;
  646.                 notifyOnNew := fMessagesWindow.fNotify.IsOn;
  647.                 fNewWindow.GetGlobalBounds(r);
  648.                 newWindPos := r.topLeft;
  649.                 newWindShown := fNewWindow.IsShown;
  650.                 fStatusWindow.GetGlobalBounds(r);
  651.                 statusWindPos := r.topLeft;
  652.                 statusWindShown := fStatusWindow.IsShown;
  653.                 totalMessages := fStatusWindow.fTotalMessages.GetValue;
  654.                 passedMessages := fStatusWindow.fTotalPassed.GetValue;
  655.             end;
  656.         { Write the display state. }
  657.         l := sizeof(dispRec);
  658.         FailOSErr(FSWrite(aRefNum,l,@dispRec));
  659.         { Write the configuration. }
  660.         config := fConfig;
  661.         l := sizeof(config);
  662.         FailOSErr(FSWrite(aRefNum,l,@config));
  663.         { Write the message count. }
  664.         n := fMessages.fSize;
  665.         l := sizeof(n);
  666.         FailOSErr(FSWrite(aRefNum,l,@n));
  667.         { Write the messages. }
  668.         fMessages.Each(saveOne);
  669.     end;
  670.  
  671. {--------------------------------------------------------------------------------------------------}
  672.  
  673. {$S ARes}
  674.  
  675. procedure TLACSDocument.ExpireMessages;
  676.     { Check for expired messages, and dump them if they are expired. }
  677.  
  678.     procedure expireOne(r: TMessage);
  679.         { Check one message. }
  680.  
  681.         begin
  682.             if Expired(r.fExpireDate) then r.Free;
  683.         end;
  684.  
  685.     begin
  686.         fMessages.Each(expireOne);
  687.     end;
  688.  
  689. {--------------------------------------------------------------------------------------------------}
  690.  
  691. {$S AFields}
  692.  
  693. procedure TLACSDocument.Fields(procedure DoToField(fieldName: Str255; fieldAddr: Ptr;
  694.                                     fieldType: integer));
  695.  
  696.     var s: Str255;
  697.  
  698.     begin
  699.         DoToField('TLACSDocument', nil, bClass);
  700.         DoToField('fMessages', @fMessages, bObject);
  701.         DoToField('fMessagesWindow', @fMessagesWindow, bObject);
  702.         DoToField('fNewWindow', @fNewWindow, bObject);
  703.         DoToField('fStatusWindow', @fStatusWindow, bObject);
  704.         DoToField('fDocumentSaver', @fDocumentSaver, bObject);
  705.         DoToField('fMessagesExpirator', @fMessagesExpirator, bObject);
  706.         DoToField('fZoneLooker', @fZoneLooker, bObject);
  707.         DoToField('fNodeLooker', @fNodeLooker, bObject);
  708.         DoToField('fGossiper', @fGossiper, bObject);
  709.         DoToField('fGossipee', @fGossipee, bObject);
  710.         DoToField('fConfig.inZoneSearch', @fConfig.inZoneSearch, bInteger);
  711.         DoToField('fConfig.push', @fConfig.push, bBoolean);
  712.         DoToField('fConfig.pull', @fConfig.pull, bBoolean);
  713.         DoToField('fConfig.pullOnLess', @fConfig.pullOnLess, bInteger);
  714.         DoToField('fConfig.count', @fConfig.count, bBoolean);
  715.         DoToField('fConfig.countValue', @fConfig.countValue, bInteger);
  716.         DoToField('fConfig.feedback', @fConfig.feedback, bBoolean);
  717.         DoToField('fConfig.delayBase', @fConfig.delayBase, bLongInt);
  718.         DoToField('fConfig.delayExp', @fConfig.delayExp, bLongInt);
  719.         DoToField('fConfig.expireIn', @fConfig.expireIn, bLongInt);
  720.         DoToField('fConfig.defaultFilter', @fConfig.defaultFilter, bString);
  721.         DoToField('fConfig.defaultType', @fConfig.defaultType, bString);
  722.         case fConfig.forwarding of
  723.             kForwardManually: s := 'kForwardManually';
  724.             kForwardIfSigned: s := 'kForwardIfSigned';
  725.             kForwardAlways: s := 'kForwardAlways';
  726.             end;
  727.         DoToField('fConfig.forwarding', @s, bString);
  728.         case fConfig.signature of
  729.             kNoSignature: s := 'kNoSignature';
  730.             kSignatureFromChooser: s := 'kSignatureFromChooser';
  731.             kSignatureFromUser: s := 'kSignatureFromUser';
  732.             end;
  733.         DoToField('fConfig.signature', @s, bString);
  734.         DoToField('fConfig.userSignature', @fConfig.userSignature, bString);
  735.         DoToField('fUseDisplayState', @fUseDisplayState, bBoolean);
  736.         DoToField('fDisplayState.messagesWindPos', @fDisplayState.messagesWindPos, bPoint);
  737.         DoToField('fDisplayState.messagesWindShown', @fDisplayState.messagesWindShown, bBoolean);
  738.         DoToField('fDisplayState.notifyOnNew', @fDisplayState.notifyOnNew, bBoolean);
  739.         DoToField('fDisplayState.newWindPos', @fDisplayState.newWindPos, bPoint);
  740.         DoToField('fDisplayState.newWindShown', @fDisplayState.newWindShown, bBoolean);
  741.         DoToField('fDisplayState.statusWindPos', @fDisplayState.statusWindPos, bPoint);
  742.         DoToField('fDisplayState.statusWindShown', @fDisplayState.statusWindShown, bBoolean);
  743.         DoToField('fDisplayState.totalMessages', @fDisplayState.totalMessages, bLongInt);
  744.         DoToField('fDisplayState.passedMessages', @fDisplayState.passedMessages, bLongInt);
  745.         inherited Fields(DoToField);
  746.     end;
  747.  
  748. {--------------------------------------------------------------------------------------------------}
  749.  
  750. {$S AFree}
  751.  
  752. procedure TLACSDocument.Free;
  753.         { Free the document. }
  754.  
  755.     var ignore: OSErr;
  756.  
  757.     begin
  758.         { Free all the messages, and the list itself. }
  759.         fMessages.FreeList;
  760.         { Free the periodic objects. }
  761.         FreeIfObject(fDocumentSaver);
  762.         FreeIfObject(fMessagesExpirator);
  763.         FreeIfObject(fZoneLooker);
  764.         FreeIfObject(fNodeLooker);
  765.         FreeIfObject(fGossiper);
  766.         FreeIfObject(fGossipee);
  767.         { Free the windows. }
  768.         FreeIfObject(fMessagesWindow);
  769.         FreeIfObject(fNewWindow);
  770.         FreeIfObject(fStatusWindow);
  771.         inherited Free;
  772.     end;
  773.  
  774. {--------------------------------------------------------------------------------------------------}
  775.  
  776. {$S ARes}
  777.  
  778. function TLACSDocument.GetHotMessage: TMessage;
  779.     { Find a hot message, if there are any. }
  780.  
  781.     var hotness: integer;
  782.  
  783.     procedure checkForHot(r: TMessage);
  784.         { Check the temperature of a message. }
  785.  
  786.         begin
  787.             if r.IsHot and r.fForward then
  788.                 if (r.fBadPasses + r.fSuccessfulPasses) < hotness then
  789.                     begin
  790.                         GetHotMessage := r;
  791.                         hotness := r.fBadPasses + r.fSuccessfulPasses;
  792.                     end;
  793.         end;
  794.  
  795.     begin
  796.         { Find the hotest message there is. }
  797.         hotness := 32000;
  798.         GetHotMessage := nil;
  799.         fMessages.Each(checkForHot);
  800.     end;
  801.     
  802. {--------------------------------------------------------------------------------------------------}
  803.  
  804. {$S ARes}
  805.  
  806. procedure TLACSDocument.GetPreferences;
  807.     { Query the user for his preferences. }
  808.  
  809.     var aWindow: TWindow;
  810.         forwMan, forwSig, forwAll: TRadio;
  811.         sigNone, sigChooser, sigUser: TRadio;
  812.         sig: TEditText;
  813.         s: Str255;
  814.  
  815.     begin
  816.         { Get the dialog window. }
  817.         aWindow := NewTemplateWindow(kPreferencesWindow, NIL);
  818.         FailNIL(aWindow);
  819.  
  820.         { Find all the radio buttons and the TEditText. }
  821.         forwMan := TRadio(aWindow.FindSubView('Manu'));
  822.         forwSig := TRadio(aWindow.FindSubView('Auts'));
  823.         forwAll := TRadio(aWindow.FindSubView('Auta'));
  824.         sigNone := TRadio(aWindow.FindSubView('Nosi'));
  825.         sigChooser := TRadio(aWindow.FindSubView('Sigc'));
  826.         sigUser := TRadio(aWindow.FindSubView('Sigu'));
  827.         sig := TEditText(aWindow.FindSubView('Sign'));
  828.  
  829.         { Set them to the current configuration. }
  830.         forwMan.SetState(fConfig.forwarding = kForwardManually,false);
  831.         forwSig.SetState(fConfig.forwarding = kForwardIfSigned,false);
  832.         forwAll.SetState(fConfig.forwarding = kForwardAlways,false);
  833.         sigNone.SetState(fConfig.signature = kNoSignature,false);
  834.         sigChooser.SetState(fConfig.signature = kSignatureFromChooser,false);
  835.         sigUser.SetState(fConfig.signature = kSignatureFromUser,false);
  836.         s := fConfig.userSignature;
  837.         sig.SetText(s,false);
  838.  
  839.         { Query the user, but only listen to the result if the user clicks on OK. }
  840.         if TDialogView(aWindow.FindSubView('DLOG')).PoseModally = 'OKOK' then
  841.             begin
  842.                 { Record the new configuration. }
  843.                 if forwMan.IsOn then fConfig.forwarding := kForwardManually
  844.                 else if forwSig.IsOn then fConfig.forwarding := kForwardIfSigned
  845.                 else if forwAll.IsOn then fConfig.forwarding := kForwardAlways;
  846.                 if sigNone.IsOn then fConfig.signature := kNoSignature
  847.                 else if sigChooser.IsOn then fConfig.signature := kSignatureFromChooser
  848.                 else if sigUser.IsOn then fConfig.signature := kSignatureFromUser;
  849.                 sig.GetText(s);
  850.                 fConfig.userSignature := s;
  851.                 fNewWindow.GetSignature;
  852.             end;
  853.  
  854.         { Close the window and release it. }
  855.         aWindow.Close;
  856.     end;
  857.  
  858. {--------------------------------------------------------------------------------------------------}
  859.  
  860. {$S ARes}
  861.  
  862. function TLACSDocument.GetRandomMessage: TMessage;
  863.     { Find a message at random. }
  864.  
  865.     begin
  866.         if fMessages.fSize <= 0 then GetRandomMessage := nil
  867.         else GetRandomMessage := TMessage(fMessages.At(abs(Random) mod fMessages.fSize + 1));
  868.     end;
  869.  
  870. {--------------------------------------------------------------------------------------------------}
  871.  
  872. {$S ARes}
  873.  
  874. function TLACSDocument.GetMessage(f: Str32; t: Str32; h: Handle): TMessage;
  875.     { Get the message that corresponds to the filter/type/handle given. }
  876.  
  877.     function eqMessage(r: TMessage): boolean;
  878.         { Check if this is the message we're looking for. }
  879.  
  880.         var p1, p2: Ptr;
  881.             sz: longInt;
  882.  
  883.         begin
  884.             eqMessage := false;
  885.             { Does it have the same type and filter? }
  886.             if (f = r.fFilter) and (t = r.fType) then
  887.                 begin
  888.                     { Does it have the same text? }
  889.                     sz := GetHandleSize(h);
  890.                     if sz = GetHandleSize(r.fText) then
  891.                         begin
  892.                             p1 := h^; p2 := r.fText^;
  893.                             while sz > 0 do
  894.                                 begin
  895.                                     if p1^ <> p2^ then exit(eqMessage);
  896.                                     p1 := Ptr(ord4(p1)+1);
  897.                                     p2 := Ptr(ord4(p2)+1);
  898.                                     sz := sz-1;
  899.                                 end;
  900.                             eqMessage := true;
  901.                         end;
  902.                 end;
  903.         end;
  904.  
  905.     begin
  906.         GetMessage := TMessage(fMessages.FirstThat(eqMessage));
  907.     end;
  908.  
  909. {--------------------------------------------------------------------------------------------------}
  910.  
  911. {$S ARes}
  912.  
  913. function TLACSDocument.HandleIncomingCommand(theData: Ptr; theSz: longInt): longInt;
  914.     { Handle an incoming command. If there's a reply, put it into the same buffer and return the size. }
  915.  
  916.     var p: Ptr;
  917.         h: Handle;
  918.         cmd: Str255;
  919.         messageFilter: Str255;
  920.         messageType: Str255;
  921.         sd: longInt;
  922.         ed: longInt;
  923.         i: integer;
  924.         sz: longInt;
  925.         answerSz: longInt;
  926.         r: TMessage;
  927.  
  928.     procedure getNextString(var p: Ptr; var sz: longInt; var s: Str255; maxSize: integer);
  929.         { Get the next string in the command. }
  930.  
  931.         var i: integer;
  932.             pStart: Ptr;
  933.  
  934.         begin
  935.             i := 0;
  936.             pStart := p;
  937.             while (sz > 0) and (p^ <> kTab) do
  938.                 begin
  939.                     p := Ptr(ord4(p)+1);
  940.                     sz := sz-1;
  941.                     if i < maxSize then i := i+1;
  942.                 end;
  943.             s[0] := chr(i);
  944.             BlockMove(pStart,Ptr(ord4(@s)+1),i);
  945.             while (sz > 0) and (p^ <> kTab) do
  946.                 begin
  947.                     p := Ptr(ord4(p)+1);
  948.                     sz := sz-1;
  949.                 end;
  950.             if sz > 0 then
  951.                 begin
  952.                     p := Ptr(ord4(p)+1);
  953.                     sz := sz-1;
  954.                 end;
  955.         end;
  956.  
  957.     function getNextHandle(var p: Ptr; var sz: longInt; maxSize: longInt): Handle;
  958.         { Get the next handle (indefinite length string) in the command. }
  959.  
  960.         var pStart: Ptr;
  961.             szToGet: longInt;
  962.  
  963.         begin
  964.             pStart := p;
  965.             while (sz > 0) and (p^ <> kTab) do
  966.                 begin
  967.                     p := Ptr(ord4(p)+1);
  968.                     sz := sz-1;
  969.                 end;
  970.             szToGet := ord4(p)-ord4(pStart);
  971.             if szToGet > maxSize then szToGet := maxSize;
  972.             h := NewHandle(szToGet);
  973.             if h <> nil then BlockMove(pStart,h^,szToGet);
  974.             if p^ = kTab then
  975.                 begin
  976.                     p := Ptr(ord4(p)+1);
  977.                     sz := sz-1;
  978.                 end;
  979.             getNextHandle := h;
  980.         end;
  981.  
  982.     function getNextLong(var p: Ptr; var sz: longInt): longInt;
  983.         { Get the next longInt in the command. }
  984.  
  985.         var s: Str255;
  986.             l: longInt;
  987.  
  988.         begin
  989.             getNextString(p,sz,s,255);
  990.             StringToNum(s,l);
  991.             getNextLong := l;
  992.         end;
  993.  
  994.     begin
  995.         sz := theSz;
  996.         answerSz := 0;
  997.         p := theData;
  998.         h := nil;
  999.         { Get the command. }
  1000.         getNextString(p,sz,cmd,255);
  1001.         { Check for a new message command. }
  1002.         if cmd = 'Rumor' then
  1003.             begin
  1004.                 { Get the message. }
  1005.                 getNextString(p,sz,messageFilter,32);
  1006.                 getNextString(p,sz,messageType,32);
  1007.                 h := getNextHandle(p,sz,kMaxMessageSize);
  1008.                 if h <> nil then
  1009.                     begin
  1010.                         sd := getNextLong(p,sz);
  1011.                         if sd = 0 then sd := GetNow;
  1012.                         ed := getNextLong(p,sz);
  1013.                         { Have we heard it? }
  1014.                         r := GetMessage(messageFilter,messageType,h);
  1015.                         { If yes, then reply that it's cold. }
  1016.                         if r <> nil then cmd := 'ColdRumor'
  1017.                         { Otherwise remember it and reply that it's hot. }
  1018.                         else
  1019.                             begin
  1020.                                 NewMessage(false,messageFilter,messageType,h,sd,ed,false);
  1021.                                 cmd := 'HotRumor';
  1022.                             end;
  1023.                         { Build our answer. }
  1024.                         PutNextString(theData,answerSz,cmd);
  1025.                         PutNextString(theData,answerSz,messageFilter);
  1026.                         PutNextString(theData,answerSz,messageType);
  1027.                         PutNextHandle(theData,answerSz,h);
  1028.                     end;
  1029.             end
  1030.         { Check for cold message reply. }
  1031.         else if cmd = 'ColdRumor' then
  1032.             begin
  1033.                 { Get the message. }
  1034.                 getNextString(p,sz,messageFilter,32);
  1035.                 getNextString(p,sz,messageType,32);
  1036.                 h := getNextHandle(p,sz,kMaxMessageSize);
  1037.                 { Find it and cool it off. }
  1038.                 r := GetMessage(messageFilter,messageType,h);
  1039.                 if r <> nil then r.FailedPass;
  1040.             end
  1041.         { Check for hot message reply. }
  1042.         else if cmd = 'HotRumor' then
  1043.             begin
  1044.                 { Get the message. }
  1045.                 getNextString(p,sz,messageFilter,32);
  1046.                 getNextString(p,sz,messageType,32);
  1047.                 h := getNextHandle(p,sz,kMaxMessageSize);
  1048.                 { Find it and warm it up. }
  1049.                 r := GetMessage(messageFilter,messageType,h);
  1050.                 if r <> nil then r.SuccessfullPass;
  1051.             end
  1052.         { Check for a dump our parameters command. }
  1053.         else if cmd = 'DumpParams' then
  1054.             begin
  1055.                 { Build a reply telling what our parameters are. }
  1056.                 PutNextString(theData,answerSz,'Params');
  1057.                 PutNextString(theData,answerSz,Concat(
  1058.                     'Version ',kApplicationVersion,
  1059.                     'InZoneSearch ',LongAsString(fConfig.inZoneSearch),
  1060.                     ' Push ',BoolAsString(fConfig.push),
  1061.                     ' Pull ',BoolAsString(fConfig.pull),
  1062.                     ' PullOnLess ',LongAsString(fConfig.pullOnLess),
  1063.                     ' Count ',BoolAsString(fConfig.count),
  1064.                     ' CountValue ',LongAsString(fConfig.countValue),
  1065.                     ' Feedback ',BoolAsString(fConfig.feedback),
  1066.                     ' DelayBase ',LongAsString(fConfig.delayBase),
  1067.                     ' DelayExp ',LongAsString(fConfig.delayExp)));
  1068.             end
  1069.         { Check for a pull command. }
  1070.         else if cmd = 'Pull' then
  1071.             begin
  1072.                 { Get a message and return it. }
  1073.                 r := GetHotMessage;
  1074.                 if r <> nil then answerSz := r.BuildMessageCommand(theData);
  1075.             end
  1076.         { Check for a pull-even-if-it's-cold command. }
  1077.         else if cmd = 'PullCold' then
  1078.             begin
  1079.                 { Get a message, any message, and return it. }
  1080.                 r := GetHotMessage;
  1081.                 if r = nil then r := GetRandomMessage;
  1082.                 if r <> nil then
  1083.                     if not r.fForward then r := nil;
  1084.                 if r <> nil then answerSz := r.BuildMessageCommand(theData);
  1085.             end;
  1086.         { If we've built a reply, terminate it with the return. }
  1087.         if answerSz > 0 then
  1088.             begin
  1089.                 theData^ := kReturn;
  1090.                 answerSz := answerSz+1;
  1091.             end;
  1092.         if h <> nil then DisposHandle(h);
  1093.         HandleIncomingCommand := answerSz;
  1094.     end;
  1095.  
  1096. {--------------------------------------------------------------------------------------------------}
  1097.  
  1098. {$S AInit}
  1099.  
  1100. procedure TLACSDocument.ILACSDocument;
  1101.     { Intialize the document. }
  1102.  
  1103.     begin
  1104.         IDocument(kLACSSettings, kSignature, kUsesDataFork, NOT kUsesRsrcFork, kDataOpen, NOT kRsrcOpen);
  1105.  
  1106.         { We make the windows here instead of in DoMakeView/Windows because we keep some of the model
  1107.             information in window objects, so we need them around when we're reading in the document. }
  1108.         fMessagesWindow := TMessagesWindow(NewTemplateWindow(kMessagesWindow,self));
  1109.         fMessagesWindow.FindSubviews;
  1110.         fNewWindow := TNewWindow(NewTemplateWindow(kNewWindow,self));
  1111.         fNewWindow.FindSubviews;
  1112.         fStatusWindow := TStatusWindow(NewTemplateWindow(kStatusWindow,self));
  1113.         fStatusWindow.FindSubviews;
  1114.  
  1115.  
  1116.         { Clear out the periodic functions. }
  1117.         fDocumentSaver := nil;
  1118.         fMessagesExpirator := nil;
  1119.         fZoneLooker := nil;
  1120.         fNodeLooker := nil;
  1121.         fGossiper := nil;
  1122.         fGossipee := nil;
  1123.  
  1124.         { Init the message list. }
  1125.         fMessages := NewList;
  1126.     end;
  1127.  
  1128. {--------------------------------------------------------------------------------------------------}
  1129.  
  1130. {$S ARes}
  1131.  
  1132. procedure TLACSDocument.MarkAllAsRead;
  1133.     { Mark all messages as read. }
  1134.  
  1135.     procedure markOne(r: TMessage);
  1136.         { Mark one message as read. }
  1137.  
  1138.         begin
  1139.             r.MarkAsRead;
  1140.         end;
  1141.  
  1142.     begin
  1143.         fMessagesWindow.fUnread.Each(markOne);
  1144.     end;
  1145.  
  1146. {--------------------------------------------------------------------------------------------------}
  1147.  
  1148. {$S ARes}
  1149.  
  1150. procedure TLACSDocument.NewMessage(ru: boolean; f: Str32; t: Str32; h: Handle; sd: longInt; ed: longInt;
  1151.                                                                 alwaysForward: boolean);
  1152.     { Enter a new message into the document. }
  1153.  
  1154.     var nr: TMessage;
  1155.  
  1156.     begin
  1157.         { Only record it is it hasn't already expired. }
  1158.         if (not Expired(ed)) and (GetHandleSize(h) > 0) then
  1159.             begin
  1160.                 { Notify the user. }
  1161.                 fMessagesWindow.Notify;
  1162.                 fStatusWindow.SetStatus(kStatNewMessage);
  1163.                 { Create the message. }
  1164.                 new(nr);
  1165.                 FailNil(nr);
  1166.                 nr.IMessage(self, ru, f, t, h, sd, ed);
  1167.                 if alwaysForward then nr.fForward := true;
  1168.                 fStatusWindow.IncTotalMessages(1);
  1169.                 { Get the gossiper moving if he isn't already. }
  1170.                 fGossiper.Kick;
  1171.             end;
  1172.     end;
  1173.  
  1174. {--------------------------------------------------------------------------------------------------}
  1175.  
  1176. {$S ARes}
  1177.  
  1178. procedure TLACSDocument.ParseAsParams(h: Handle);
  1179.     { Interpret the data in the handle as a configuration setting string. }
  1180.  
  1181.     var p: Ptr;
  1182.         sz: longInt;
  1183.         s: Str255;
  1184.  
  1185.     procedure nextWord;
  1186.         { Return the next word in the input. }
  1187.  
  1188.         var strt: Ptr;
  1189.             l: longInt;
  1190.  
  1191.         begin
  1192.             while p^ = ord(' ') do
  1193.                 begin
  1194.                     p := Ptr(ord4(p)+1);
  1195.                     sz := sz-1;
  1196.                 end;
  1197.             strt := p;
  1198.             while (sz > 0) and (p^ <> ord(' ')) do
  1199.                 begin
  1200.                     p := Ptr(ord4(p)+1);
  1201.                     sz := sz-1;
  1202.                 end;
  1203.             l := ord4(p)-ord4(strt);
  1204.             if l > 255 then l := 255;
  1205.             s[0] := chr(l);
  1206.             BlockMove(strt,Ptr(ord4(@s)+1),l);
  1207.         end;
  1208.  
  1209.     function nextInt: integer;
  1210.         { Return the next longInt in the input. }
  1211.  
  1212.         var l: longInt;
  1213.  
  1214.         begin
  1215.             nextWord;
  1216.             StringToNum(s,l);
  1217.             nextInt := l;
  1218.         end;
  1219.  
  1220.     function nextBool: boolean;
  1221.         { Return the next boolean in the input. }
  1222.  
  1223.         begin
  1224.             nextWord;
  1225.             nextBool := s = 'true';
  1226.         end;
  1227.  
  1228.     begin
  1229.         { Cycle through the input, settings parameters as indicated. }
  1230.         p := h^;
  1231.         sz := GetHandleSize(h);
  1232.         while sz > 0 do
  1233.             begin
  1234.                 nextWord;
  1235.                 if s = 'InZoneSearch' then fConfig.inZoneSearch := nextInt
  1236.                 else if s = 'Push' then fConfig.push := nextBool
  1237.                 else if s = 'Pull' then fConfig.pull := nextBool
  1238.                 else if s = 'PullOnLess' then fConfig.pullOnLess := nextInt
  1239.                 else if s = 'Count' then fConfig.count := nextBool
  1240.                 else if s = 'CountValue' then fConfig.countValue := nextInt
  1241.                 else if s = 'Feedback' then fConfig.feedback := nextBool
  1242.                 else if s = 'DelayBase' then fConfig.delayBase := nextInt
  1243.                 else if s = 'DelayExp' then fConfig.delayExp := nextInt
  1244.                 else nextWord;
  1245.             end;
  1246.     end;
  1247.  
  1248. {--------------------------------------------------------------------------------------------------}
  1249.  
  1250. {$S AOpen}
  1251.  
  1252. procedure TLACSDocument.ShowWindows;
  1253.     { Display windows (or not) as appropriate. }
  1254.  
  1255.     begin
  1256.         { First, make sure we've got our memory allocation in hand. }
  1257.         CheckFreeSpace;
  1258.         { Calculate the current signature. }
  1259.         fNewWindow.GetSignature;
  1260.         {Open up the windows. }
  1261.         fStatusWindow.Open;
  1262.         fNewWindow.Open;
  1263.         fMessagesWindow.Open;
  1264.         if fUseDisplayState then
  1265.             begin
  1266.                 if fDisplayState.statusWindShown then fStatusWindow.Select
  1267.                 else fStatusWindow.Show(false,false);
  1268.                 if fDisplayState.newWindShown then fNewWindow.Select
  1269.                 else fNewWindow.Show(false,false);
  1270.                 if fDisplayState.messagesWindShown then fMessagesWindow.Select
  1271.                 else fMessagesWindow.Show(false,false);
  1272.             end
  1273.         else
  1274.             begin
  1275.                 fStatusWindow.Select;
  1276.                 fNewWindow.Select;
  1277.                 fMessagesWindow.Select;
  1278.             end;
  1279.     end;
  1280.  
  1281. {--------------------------------------------------------------------------------------------------}
  1282.  
  1283. {$S ARes}
  1284.  
  1285. procedure TMessage.AsString(var aString: Str255);
  1286.     { Return a string that represents the message (for display lists). }
  1287.  
  1288.     var h: Handle;
  1289.         l: longInt;
  1290.  
  1291.     begin
  1292.         h := fText;
  1293.         { Figure out the size. }
  1294.         l := GetHandleSize(h)+2;
  1295.         if l > 255 then l := 255;
  1296.         aString[0] := chr(l);
  1297.         { Mark it as hot or cold. }
  1298.         if fHot then aString[1] := '◊'
  1299.         else aString[1] := ' ';
  1300.         aString[2] := ' ';
  1301.         { Fill in the text. }
  1302.         BlockMove(h^,Ptr(ord4(@aString)+3),l-2);
  1303.     end;
  1304.  
  1305. {--------------------------------------------------------------------------------------------------}
  1306.  
  1307. {$S ARes}
  1308.  
  1309. function TMessage.BuildMessageCommand(var theData: Ptr): longInt;
  1310.     { Build a message command into the buffer pointed to by theData, incrementing theData as we go,
  1311.         and return the size of the command built. }
  1312.  
  1313.     var sz: longInt;
  1314.      t, f: Str32;
  1315.  
  1316.     begin
  1317.         sz := 0;
  1318.         { Put in command name. }
  1319.         PutNextString(theData,sz,'Rumor');
  1320.         { Put in parameters. }
  1321.         f := fFilter;
  1322.         PutNextString(theData,sz,f);
  1323.         t := fType;
  1324.         PutNextString(theData,sz,t);
  1325.         PutNextHandle(theData,sz,fText);
  1326.         PutNextString(theData,sz,LongAsString(fStartDate));
  1327.         PutNextString(theData,sz,LongAsString(fExpireDate));
  1328.         { Terminate it with a return. }
  1329.         theData^ := kReturn;
  1330.         sz := sz+1;
  1331.         buildMessageCommand := sz;
  1332.     end;
  1333.  
  1334. {--------------------------------------------------------------------------------------------------}
  1335.  
  1336. {$S AWriteFile}
  1337.  
  1338. procedure TMessage.DoNeedDiskSpace(var dataForkBytes, rsrcForkBytes: longInt);
  1339.     { Return the amount of disk space needed to save this message. }
  1340.  
  1341.     begin
  1342.         dataForkBytes := dataForkBytes + sizeof(SavedMessage) + sizeof(longInt) + GetHandleSize(fText);
  1343.     end;
  1344.  
  1345. {--------------------------------------------------------------------------------------------------}
  1346.  
  1347. {$S ARes}
  1348.  
  1349. procedure TMessage.FailedPass;
  1350.     { Factor in one more bad pass attempt. }
  1351.  
  1352.     begin
  1353.         fBadPasses := fBadPasses+1;
  1354.         UpdateHotness;
  1355.     end;
  1356.  
  1357. {--------------------------------------------------------------------------------------------------}
  1358.  
  1359. {$S AFields}
  1360.  
  1361. procedure TMessage.Fields(procedure DoToField(fieldName: Str255; fieldAddr: Ptr;
  1362.                                         fieldType: integer));
  1363.  
  1364.     begin
  1365.         DoToField('TMessage', nil, bClass);
  1366.         DoToField('fDocument', @fDocument, bObject);
  1367.         DoToField('fHot', @fHot, bBoolean);
  1368.         DoToField('fSuccessfulPasses', @fSuccessfulPasses, bInteger);
  1369.         DoToField('fBadPasses', @fBadPasses, bInteger);
  1370.         DoToField('fFilter', @fFilter, bString);
  1371.         DoToField('fType', @fType, bString);
  1372.         DoToField('fText', @fText, bHandle);
  1373.         DoToField('fStartDate', @fStartDate, bLongInt);
  1374.         DoToField('fExpireDate', @fExpireDate, bLongInt);
  1375.         DoToField('fLastMessaged', @fLastMessaged, bLongInt);
  1376.         DoToField('fForward', @fForward, bBoolean);
  1377.         inherited Fields(DoToField);
  1378.     end;
  1379.  
  1380. {--------------------------------------------------------------------------------------------------}
  1381.  
  1382. {$S AFree}
  1383.  
  1384. procedure TMessage.Free;
  1385.     { Free the message object. }
  1386.  
  1387.     begin
  1388.         { Get us out of the main message list. }
  1389.         fDocument.fMessages.Delete(self);
  1390.         { And out of the display lists. }
  1391.         fDocument.fMessagesWindow.fUnread.Delete(self);
  1392.         fDocument.fMessagesWindow.fRead.Delete(self);
  1393.         { Factor us out of the hot/cold statistics. }
  1394.         if fHot then fDocument.fStatusWindow.IncHotMessages(-1)
  1395.         else fDocument.fStatusWindow.IncColdMessages(-1);
  1396.         { Dispose of the body. }
  1397.         DisposHandle(fText);
  1398.         { Dispose of everything else. }
  1399.         inherited Free;
  1400.     end;
  1401.  
  1402. {--------------------------------------------------------------------------------------------------}
  1403.  
  1404. {$S ARes}
  1405.  
  1406. procedure TMessage.IMessage(aDoc: TLACSDocument; isRead: boolean; f: Str32; t: Str32; newText: Handle; sd: longInt; ed: longInt);
  1407.     { Initialize a message object. }
  1408.  
  1409.     var h: Handle;
  1410.         p: Ptr;
  1411.         sz: longInt;
  1412.  
  1413.     function containsSignature: boolean;
  1414.  
  1415.         var p: Ptr;
  1416.             sz: longInt;
  1417.  
  1418.         begin
  1419.             containsSignature := false;
  1420.             p := newText^;
  1421.             sz := GetHandleSize(newText);
  1422.             while sz > 0 do
  1423.                 begin
  1424.                     if p^ = ord(kSignatureSeparator) then
  1425.                         begin
  1426.                             containsSignature := true;
  1427.                             leave;
  1428.                         end;
  1429.                     p := Ptr(ord4(p)+1);
  1430.                     sz := sz-1;
  1431.                 end;
  1432.         end;
  1433.  
  1434.     begin
  1435.         IObject;
  1436.         { Remember the document we're attached to. }
  1437.         fDocument := aDoc;
  1438.         { Duplicate the body of the message. }
  1439.         h := newText;
  1440.         if HandToHand(h) <> noErr then h := NewHandle(0);
  1441.         FailNil(h);
  1442.         if GetHandleSize(h) > kMaxMessageSize then SetHandleSize(h,kMaxMessageSize);
  1443.         { Eliminate any tabs or returns from it (they shouldn't be there anyway, but we're paranoid. }
  1444.         p := h^;
  1445.         sz := GetHandleSize(h);
  1446.         while sz > 0 do
  1447.             begin
  1448.                 if (p^ = kTab) or (p^ = kReturn) then p^ := ord(' ');
  1449.                 p := Ptr(ord4(p)+1);
  1450.                 sz := sz-1;
  1451.             end;
  1452.         { Insert ourselves into the main message list. }
  1453.         aDoc.fMessages.InsertLast(self);
  1454.         { Start out hot. }
  1455.         fHot := true;
  1456.         aDoc.fStatusWindow.IncHotMessages(1);
  1457.         { Start out unpassed. }
  1458.         fSuccessfulPasses := 0;
  1459.         fBadPasses := 0;
  1460.         { Remember the filter, type, body, and dates. }
  1461.         fFilter := f;
  1462.         fType := t;
  1463.         fText := h;
  1464.         fStartDate := sd;
  1465.         fExpireDate := ed;
  1466.         { Start remessage timer. }
  1467.         fLastMessaged := GetNow;
  1468.         { Decide how to forward. }
  1469.         if aDoc.fConfig.forwarding = kForwardManually then fForward := false;
  1470.         if aDoc.fConfig.forwarding = kForwardAlways then fForward := true
  1471.         else fForward := containsSignature;
  1472.         { Decide if we should display the message for the user. }
  1473.         if f = aDoc.fConfig.defaultFilter then
  1474.             begin
  1475.                 { If yes, then display it in one of the two lists: read or unread. }
  1476.                 if isRead then aDoc.fMessagesWindow.fRead.Insert(self)
  1477.                 else aDoc.fMessagesWindow.fUnread.Insert(self);
  1478.             end;
  1479.         { If this is a parameter message, then process the parameters. }
  1480.         if t = 'Params' then ParseAsParams;
  1481.         { Tweak our free space. }
  1482.         aDoc.CheckFreeSpace;
  1483.     end;
  1484.         
  1485. {--------------------------------------------------------------------------------------------------}
  1486.  
  1487. {$S AReadFile}
  1488.  
  1489. procedure TMessage.IMessageFromFile(aDoc: TLACSDocument; aRefNum: integer);
  1490.     { Initialize a message object from a file. }
  1491.  
  1492.     var sr: SavedMessage;
  1493.         l: longInt;
  1494.         s: longInt;
  1495.         h: Handle;
  1496.  
  1497.     begin
  1498.         { Get the saved message info (everything but the body). }
  1499.         l := sizeof(sr);
  1500.         FailOSErr(FSRead(aRefNum,l,@sr));
  1501.         { Get the size of the body. }
  1502.         l := sizeof(s);
  1503.         FailOSERR(FSRead(aRefNum,l,@s));
  1504.         { Allocate and read the body of the message. }
  1505.         h := NewHandle(s);
  1506.         FailNil(h);
  1507.         HLock(h);
  1508.         FailOSErr(FSRead(aRefNum,s,h^));
  1509.         HUnlock(h);
  1510.         { Initialize the message. }
  1511.         IMessage(aDoc, sr.inReadList, sr.filter, sr.rType, h, sr.startDate, sr.expireDate);
  1512.         { Set it's hotness, passes, and last messaged fields. }
  1513.         fHot := sr.hot;
  1514.         if not sr.hot then
  1515.             begin
  1516.                 aDoc.fStatusWindow.IncHotMessages(-1);
  1517.                 aDoc.fStatusWindow.IncColdMessages(1);
  1518.             end;
  1519.         fSuccessfulPasses := sr.successfulPasses;
  1520.         fBadPasses := sr.badPasses;
  1521.         fLastMessaged := sr.lastMessaged;
  1522.         fForward := sr.forward;
  1523.         { Free our copy of the body (IMessage makes its own copy). }
  1524.         DisposHandle(h);
  1525.     end;
  1526.  
  1527. {--------------------------------------------------------------------------------------------------}
  1528.  
  1529. {$S ARes}
  1530.  
  1531. function TMessage.IsHot: boolean;
  1532.     { Return true if this message is still hot, and if enough time has passed for it to be spread again. }
  1533.  
  1534.     var l: longInt;
  1535.         age: longInt;
  1536.  
  1537.     begin
  1538.         { Assume it's not hot. }
  1539.         IsHot := false;
  1540.         { First off, it must actually be hot. }
  1541.         if fHot then
  1542.             begin
  1543.                 { Second, enough time must have passed. }
  1544.                 age := fDocument.fConfig.delayBase * fBadPasses;
  1545.                 for l := 1 to fDocument.fConfig.delayExp-1 do age := age * fDocument.fConfig.delayBase * fBadPasses;
  1546.                 if GetNow > (fLastMessaged + age) then IsHot := true;
  1547.             end;
  1548.     end;
  1549.  
  1550. {--------------------------------------------------------------------------------------------------}
  1551.  
  1552. {$S ARes}
  1553.  
  1554. procedure TMessage.MarkAsRead;
  1555.     { Mark this message as read. }
  1556.  
  1557.     begin
  1558.         { Take it out of the unread list. }
  1559.         fDocument.fMessagesWindow.fUnread.Delete(self);
  1560.         { Put it into the read list, if it isn't already there. }
  1561.         if fDocument.fMessagesWindow.fRead.GetSameItemNo(self) = kEmptyIndex then
  1562.             fDocument.fMessagesWindow.fRead.Insert(self);
  1563.     end;
  1564.  
  1565. {--------------------------------------------------------------------------------------------------}
  1566.  
  1567. {$S ARes}
  1568.  
  1569. procedure TMessage.ParseAsParams;
  1570.     { Parse ourself as algorithm parameters. }
  1571.  
  1572.     begin
  1573.         { Just let the document do all the work. }
  1574.         fDocument.ParseAsParams(fText);
  1575.     end;
  1576.  
  1577. {--------------------------------------------------------------------------------------------------}
  1578.  
  1579. {$S ARes}
  1580.  
  1581. procedure TMessage.SuccessfullPass;
  1582.     { Factor in one more successfull pass. }
  1583.  
  1584.     begin
  1585.         fDocument.fStatusWindow.IncTotalPassed(1);
  1586.         fSuccessfulPasses := fSuccessfulPasses+1;
  1587.         UpdateHotness;
  1588.     end;
  1589.  
  1590. {--------------------------------------------------------------------------------------------------}
  1591.  
  1592. {$S ARes}
  1593.  
  1594. procedure TMessage.UpdateHotness;
  1595.     { Update the temperature of this message. }
  1596.  
  1597.     var bad: integer;
  1598.  
  1599.     begin
  1600.         { Update when we last messaged -- this is only called after a message attempt. }
  1601.         fLastMessaged := GetNow;
  1602.         { If we're hot now, see if we've cooled off. }
  1603.         if fHot then
  1604.             begin
  1605.                 { Figure out how many bad passes we think there's been. }
  1606.                 bad := fBadPasses;
  1607.                 { If we're not using feedback, then count successfull passes as bad. }
  1608.                 if not fDocument.fConfig.feedback then bad := bad + fSuccessfulPasses;
  1609.                 { Deterministic? }
  1610.                 if fDocument.fConfig.count then
  1611.                     begin
  1612.                         if bad > fDocument.fConfig.countValue then fHot := false;
  1613.                     end
  1614.                 { ... or statictical? }
  1615.                 else
  1616.                     begin
  1617.                         if (abs(Random) mod fDocument.fConfig.countValue) = 0 then fHot := false;
  1618.                     end;
  1619.                 { If we've cooled off, then update the lists and the statistics. }
  1620.                 if not fHot then
  1621.                     begin
  1622.                         fDocument.fMessagesWindow.fUnread.Invalidate(self);
  1623.                         fDocument.fMessagesWindow.fRead.Invalidate(self);
  1624.                         fDocument.fStatusWindow.IncHotMessages(-1);
  1625.                         fDocument.fStatusWindow.IncColdMessages(1);
  1626.                     end;
  1627.             end;
  1628.     end;
  1629.  
  1630. {--------------------------------------------------------------------------------------------------}
  1631.  
  1632. {$S AWriteFile}
  1633.  
  1634. procedure TMessage.WriteToFile(aRefNum: integer);
  1635.     { Save this message to disk. }
  1636.  
  1637.     var sr: SavedMessage;
  1638.         l: longInt;
  1639.         n: longInt;
  1640.         h: Handle;
  1641.         fi: FailInfo;
  1642.  
  1643.     procedure hdlFailure(error: OSErr; message: LongInt);
  1644.         { If we fail, unlock the handle. }
  1645.  
  1646.         begin
  1647.             HUnlock(h);
  1648.         end;
  1649.  
  1650.     begin
  1651.         { Fill in the non-body part of the save. }
  1652.         with sr do
  1653.             begin
  1654.                 hot := fHot;
  1655.                 successfulPasses := fSuccessfulPasses;
  1656.                 badPasses := fBadPasses;
  1657.                 filter := fFilter;
  1658.                 rType := fType;
  1659.                 startDate := fStartDate;
  1660.                 expireDate := fExpireDate;
  1661.                 lastMessaged := fLastMessaged;
  1662.                 forward := fForward;
  1663.                 inReadList := fDocument.fMessagesWindow.fRead.GetSameItemNo(self) <> kEmptyIndex;
  1664.             end;
  1665.         { Save it. }
  1666.         l := sizeof(sr);
  1667.         FailOSErr(FSWrite(aRefNum,l,@sr));
  1668.         { Write the size of the body. }
  1669.         l := sizeof(n);
  1670.         h := fText;
  1671.         n := GetHandleSize(h);
  1672.         FailOSERR(FSWrite(aRefNum,l,@n));
  1673.         { Write the body itself. }
  1674.         HLock(h);
  1675.         CatchFailures(fi,hdlFailure);
  1676.         FailOSErr(FSWrite(aRefNum,n,h^));
  1677.         Success(fi);
  1678.         HUnlock(h);
  1679.     end;
  1680.  
  1681. {--------------------------------------------------------------------------------------------------}
  1682.  
  1683. {$S ARes}
  1684.  
  1685. procedure TDisplayList.AtDelete(index: ArrayIndex);
  1686.     { Delete the entry at index. }
  1687.  
  1688.     begin
  1689.         { If it's currently in the full display, clear that. }
  1690.         if fView.IsItemSelected(index) then fDocument.fMessagesWindow.ClearCurrent;
  1691.         { Delete it from the displayed list. }
  1692.         fView.DelItemAt(index,1);
  1693.         { Delete it from our list. }
  1694.         inherited AtDelete(index);
  1695.     end;
  1696.  
  1697. {--------------------------------------------------------------------------------------------------}
  1698.  
  1699. {$S ARes}
  1700.  
  1701. function TDisplayList.Compare(item1, item2: TObject): CompareResult;
  1702.     { Compare two objects. }
  1703.  
  1704.     begin
  1705.         { Compare by origination date. }
  1706.         if TMessage(item1).fStartDate > TMessage(item2).fStartDate then Compare := kItem1GreaterThanItem2
  1707.         else if TMessage(item1).fStartDate < TMessage(item2).fStartDate then Compare := kItem1LessThanItem2
  1708.         else Compare := kItem1EqualItem2;
  1709.     end;
  1710.  
  1711. {--------------------------------------------------------------------------------------------------}
  1712.  
  1713. {$S AFields}
  1714.  
  1715. procedure TDisplayList.Fields(procedure DoToField(fieldName: Str255; fieldAddr: Ptr;
  1716.                                         fieldType: integer)); override;
  1717.  
  1718.     begin
  1719.         DoToField('TDisplayList', nil, bClass);
  1720.         DoToField('fDocument', @fDocument, bObject);
  1721.         DoToField('fView', @fView, bObject);
  1722.         inherited Fields(DoToField);
  1723.     end;
  1724.  
  1725. {--------------------------------------------------------------------------------------------------}
  1726.  
  1727. {$S ARes}
  1728.  
  1729. procedure TDisplayList.FreeAll;
  1730.     { Free everything. }
  1731.  
  1732.     begin
  1733.         { Clear out the view. }
  1734.         fView.DelItemFirst(fView.fNumOfRows);
  1735.         { Clear out the list. }
  1736.         inherited FreeAll;
  1737.     end;
  1738.  
  1739. {--------------------------------------------------------------------------------------------------}
  1740.  
  1741. {$S AInit}
  1742.  
  1743. procedure TDisplayList.IDisplayList(theDoc: TLACSDocument; theView: TMessageListView);
  1744.     { Initialize the list. }
  1745.  
  1746.     begin
  1747.         ISortedList;
  1748.         fDocument := theDoc;
  1749.         fView := theView;
  1750.         theView.fList := self;
  1751.     end;
  1752.  
  1753. {--------------------------------------------------------------------------------------------------}
  1754.  
  1755. {$S ARes}
  1756.  
  1757. procedure TDisplayList.Insert(item: TObject);
  1758.     { Insert an item into the list. }
  1759.  
  1760.     var index: ArrayIndex;
  1761.  
  1762.     {$Push} {$IFC qTrace} {$D+} {$ENDC}
  1763.  
  1764.     function TestItem(anItem: TObject): CompareResult;
  1765.  
  1766.         begin
  1767.             if qDebug then FailNonObject(anItem);
  1768.             TestItem := Compare(item, anItem);
  1769.         end;
  1770.     {$Pop}
  1771.  
  1772.     begin
  1773.         if qDebug then FailNonObject(item);
  1774.  
  1775.         if DoSearch(TestItem, index) <> nil then;            { Discard result. }
  1776.         InsertBefore(index, item);
  1777.         fView.InsItemBefore(index,1);
  1778.     end;
  1779.  
  1780. {--------------------------------------------------------------------------------------------------}
  1781.  
  1782. {$S ARes}
  1783.  
  1784. procedure TDisplayList.Invalidate(o: TObject);
  1785.     { Invalidate the displayed object. }
  1786.  
  1787.     var n: ArrayIndex;
  1788.  
  1789.     begin
  1790.         n := GetSameItemNo(o);
  1791.         if n <> kEmptyIndex then fView.InvalidateItem(n);
  1792.     end;
  1793.  
  1794. {--------------------------------------------------------------------------------------------------}
  1795.  
  1796. {$S ARes}
  1797.  
  1798. procedure TDisplayList.Select(o: TObject);
  1799.     { Select the displayed object. }
  1800.  
  1801.     begin
  1802.         fView.SelectItem(GetSameItemNo(o),false,true,true);
  1803.         fView.ScrollSelectionIntoView(true);
  1804.     end;
  1805.  
  1806. {--------------------------------------------------------------------------------------------------}
  1807.  
  1808. {$S ARes}
  1809.  
  1810. procedure TMessagesWindow.ClearCurrent;
  1811.     { Clear out the selected message display. }
  1812.  
  1813.     begin
  1814.         fRead.fView.SetEmptySelection(false);
  1815.         fShow.SetText('');
  1816.         fShow.ShowReverted;
  1817.         fOriginated.SetText('',true);
  1818.         fExpires.SetText('',true);
  1819.         fForward.SetState(false,true);
  1820.     end;
  1821.  
  1822. {--------------------------------------------------------------------------------------------------}
  1823.  
  1824. {$S ARes}
  1825.  
  1826. procedure TMessagesWindow.DisplayMessage(r: TMessage);
  1827.     { Display message r. }
  1828.  
  1829.     var h: Handle;
  1830.         s, s2: Str255;
  1831.  
  1832.     begin
  1833.         { Show the text body. }
  1834.         h := r.fText;
  1835.         FailOSErr(HandToHand(h));
  1836.         fShow.StuffText(h);
  1837.         fShow.ShowReverted;
  1838.         { Show the origination date. }
  1839.         IUDateString(r.fStartDate,abbrevDate,s);
  1840.         Delete(s,1,5);
  1841.         IUTimeString(r.fStartDate,false,s2);
  1842.         fOriginated.SetText(Concat(s,'  ',s2),true);
  1843.         { Show the expiration date. }
  1844.         IUDateString(r.fExpireDate,AbbrevDate,s);
  1845.         Delete(s,1,5);
  1846.         IUTimeString(r.fExpireDate,false,s2);
  1847.         s := Concat(s,'  ',s2);
  1848.         fExpires.SetText(s,true);
  1849.         fForward.SetState(r.fForward,true);
  1850.         { Select the line in the read message list. }
  1851.         fRead.Select(r);
  1852.     end;
  1853.  
  1854. {--------------------------------------------------------------------------------------------------}
  1855.  
  1856. {$S ARes}
  1857.  
  1858. procedure TMessagesWindow.DoChoice(origView: TView; itsChoice: integer);
  1859.     { Handle button hits, etc. }
  1860.  
  1861.     var ourDoc: TLACSDocument;
  1862.         i: integer;
  1863.         r: TMessage;
  1864.  
  1865.     begin
  1866.         { Send Message? }
  1867.         if origView = fForward then
  1868.             begin
  1869.                 i := fRead.fView.FirstSelectedItem;
  1870.                 if i > 0 then r := TMessage(fRead.At(i));
  1871.                 if r <> nil then r.fForward := fForward.IsOn;
  1872.             end
  1873.         { Otherwise, let the defaults have it. }
  1874.         else inherited DoChoice(origView,itsChoice);
  1875.     end;
  1876.  
  1877. {--------------------------------------------------------------------------------------------------}
  1878.  
  1879. {$S AFields}
  1880.  
  1881. procedure TMessagesWindow.Fields(procedure DoToField(fieldName: Str255; fieldAddr: Ptr;
  1882.                                         fieldType: integer)); override;
  1883.  
  1884.     begin
  1885.         DoToField('TMessagesWindow', nil, bClass);
  1886.         DoToField('fNotification', @fNotification, bPointer);
  1887.         DoToField('fUnread', @fUnread, bObject);
  1888.         DoToField('fNotify', @fNotify, bObject);
  1889.         DoToField('fRead', @fRead, bObject);
  1890.         DoToField('fShow', @fShow, bObject);
  1891.         DoToField('fOriginated', @fOriginated, bObject);
  1892.         DoToField('fExpires', @fExpires, bObject);
  1893.         inherited Fields(DoToField);
  1894.     end;
  1895.  
  1896. {--------------------------------------------------------------------------------------------------}
  1897.  
  1898. {$S AInit}
  1899.  
  1900. procedure TMessagesWindow.FindSubviews;
  1901.     { Lookup all our subviews for later. }
  1902.  
  1903.     var dl: TDisplayList;
  1904.  
  1905.     begin
  1906.         fNotification := Pointer(NewPtr(sizeof(NMRec)));
  1907.         FailNil(fNotification);
  1908.         new(dl);
  1909.         FailNil(dl);
  1910.         dl.IDisplayList(TLACSDocument(fDocument),TMessageListView(FindSubView('Unre')));
  1911.         dl.FreeAll;
  1912.         fUnread := dl;
  1913.         fNotify := TCheckBox(FindSubView('Noti'));
  1914.         new(dl);
  1915.         FailNil(dl);
  1916.         dl.IDisplayList(TLACSDocument(fDocument),TMessageListView(FindSubView('Read')));
  1917.         dl.FreeAll;
  1918.         fRead := dl;
  1919.         fShow := TTEView(FindSubView('Show'));
  1920.         fOriginated := TStaticText(FindSubView('Orig'));
  1921.         fExpires := TStaticText(FindSubView('Expi'));
  1922.         fForward := TCheckBox(FindSubView('Forw'));
  1923.     end;
  1924.  
  1925. {--------------------------------------------------------------------------------------------------}
  1926.  
  1927. {$S ARes}
  1928.  
  1929. procedure TMessagesWindow.Free;
  1930.     { Free the window. }
  1931.  
  1932.     var ignore: OSErr;
  1933.  
  1934.     begin
  1935.         ignore := NMRemove(QElemPtr(fNotification));
  1936.         DisposPtr(Ptr(fNotification));
  1937.         inherited Free;
  1938.     end;
  1939.  
  1940. {--------------------------------------------------------------------------------------------------}
  1941.  
  1942. {$S ARes}
  1943.  
  1944. procedure TMessagesWindow.KillNotify;
  1945.     { Take away the Notification Manager notification. }
  1946.  
  1947.     var ignore: OSErr;
  1948.  
  1949.     begin
  1950.         ignore := NMRemove(QElemPtr(fNotification));
  1951.     end;
  1952.  
  1953. {--------------------------------------------------------------------------------------------------}
  1954.  
  1955. {$S ARes}
  1956.  
  1957. procedure TMessagesWindow.Notify;
  1958.     { Notify the user via the Notification Manager. }
  1959.  
  1960.     var ignore: OSErr;
  1961.  
  1962.     begin
  1963.         { Only notify if we're in the background and the user wants it. }
  1964.         if fNotify.IsOn and gInBackground then
  1965.             begin
  1966.                 ignore := NMRemove(QElemPtr(fNotification));
  1967.                 with fNotification^ do
  1968.                     begin
  1969.                         qType := nmType;        { Queue type -- nmType = 8. }
  1970.                         nmMark := 1;             { Get mark in Apple menu. }
  1971.                         nmSIcon := GetResource('SICN',kMySmallIcon);    { Flashing Icon. }
  1972.                         nmSound := nil;            { No sound to be played. }
  1973.                         nmStr := nil;            { No alert box. }
  1974.                         nmResp := nil;            { No response procedure. }
  1975.                         nmRefCon := 0;            { Set to nil since we don't need A5. }
  1976.                     end;
  1977.                 ignore := NMInstall(QElemPtr(fNotification));
  1978.             end;
  1979.     end;
  1980.  
  1981. {--------------------------------------------------------------------------------------------------}
  1982.  
  1983. {$S ARes}
  1984.  
  1985. procedure TNewWindow.DoChoice(origView: TView; itsChoice: integer);
  1986.     { Handle button hits, etc. }
  1987.  
  1988.     var ourDoc: TLACSDocument;
  1989.         f, t: Str32;
  1990.         h: Handle;
  1991.         s: Str255;
  1992.  
  1993.     begin
  1994.         { Send Message? }
  1995.         if origView = fSpread then
  1996.             begin
  1997.                 { Ask the user if he's really really sure he wants to post this one. }
  1998.                 if MacAppAlert(phAreYouSure,nil) = kYesButton then
  1999.                     begin
  2000.                         { Create a new message. }
  2001.                         ourDoc := TLACSDocument(fDocument);
  2002.                         f := ourDoc.fConfig.defaultFilter;
  2003.                         t := ourDoc.fConfig.defaultType;
  2004.                         h := fInput.ExtractText;
  2005.                         { But only if there's something to say. }
  2006.                         if GetHandleSize(h) > 0 then
  2007.                             begin
  2008.                                 FailOSErr(HandToHand(h));
  2009.                                 { Add in the signature. }
  2010.                                 fSignature.GetText(s);
  2011.                                 if s <> '' then s := Concat(' ',kSignatureSeparator,' ',s);
  2012.                                 FailOSErr(PtrAndHand(Ptr(ord4(@s)+1),h,length(s)));
  2013.                                 { Post the message. }
  2014.                                 ourDoc.NewMessage(true,f,t,h,GetNow,GetExpire,true);
  2015.                                 DisposHandle(h);
  2016.                                 { Clear out the input area. }
  2017.                                 fInput.StuffText(NewHandle(0));
  2018.                                 fInput.ShowReverted;
  2019.                             end;
  2020.                     end;
  2021.             end
  2022.         { Expiration date change? }
  2023.         else if (origView = fMonth) or (origView = fDay) then GetSetExpire
  2024.         { Otherwise, let the defaults have it. }
  2025.         else inherited DoChoice(origView,itsChoice);
  2026.     end;
  2027.  
  2028. {--------------------------------------------------------------------------------------------------}
  2029.  
  2030. {$S ARes}
  2031.  
  2032. function TNewWindow.DoKeyCommand(ch: char; aKeyCode: integer;
  2033.                                                                       var info: EventInfo): TCommand; override;
  2034.     { Handle keyboard events. }
  2035.  
  2036.     begin
  2037.         { Ignore carriage returns. }
  2038.         if ch = chReturn then DoKeyCommand := gNoChanges
  2039.         { Enter is the same as a Send Message click. }
  2040.         else if ch = chEnter then
  2041.             begin
  2042.                 DoChoice(fSpread,mButtonHit);
  2043.                 DoKeyCommand := gNoChanges;
  2044.             end
  2045.         { Otherwise, let MacApp do it. }
  2046.         else DoKeyCommand := inherited DoKeyCommand(ch, aKeyCode, info);
  2047.     end;
  2048.  
  2049. {--------------------------------------------------------------------------------------------------}
  2050.  
  2051. {$S ARes}
  2052.  
  2053. function TNewWindow.ExpireExpired: boolean;
  2054.     { Check if we need to reset the expiration date. }
  2055.  
  2056.     var dt: DateTimeRec;
  2057.         s: Str255;
  2058.         l, l2: longInt;
  2059.  
  2060.     begin
  2061.         { See if we're into a new day. }
  2062.         Secs2Date(GetNow+TLACSDocument(fDocument).fConfig.expireIn,dt);
  2063.         dt.hour := 0;
  2064.         dt.minute := 0;
  2065.         dt.second := 0;
  2066.         Date2Secs(dt,l);
  2067.         with dt do
  2068.             begin
  2069.                 fYear.GetText(s);
  2070.                 StringToNum(Copy(s,3,4),l2);
  2071.                 dt.year := l2;
  2072.                 month := fMonth.GetCurrentItem;
  2073.                 day := fDay.GetCurrentItem;
  2074.                 hour := 0;
  2075.                 minute := 0;
  2076.                 second := 0;
  2077.             end;
  2078.         Date2Secs(dt,l2);
  2079.         ExpireExpired := l <> l2;
  2080.     end;
  2081.  
  2082. {--------------------------------------------------------------------------------------------------}
  2083.  
  2084. {$S AFields}
  2085.  
  2086. procedure TNewWindow.Fields(procedure DoToField(fieldName: Str255; fieldAddr: Ptr;
  2087.                                         fieldType: integer)); override;
  2088.  
  2089.     begin
  2090.         DoToField('TStatusWindow', nil, bClass);
  2091.         DoToField('fInput', @fInput, bObject);
  2092.         DoToField('fSpread', @fSpread, bObject);
  2093.         DoToField('fMonth', @fMonth, bObject);
  2094.         DoToField('fDay', @fDay, bObject);
  2095.         DoToField('fYear', @fYear, bObject);
  2096.         DoToField('fSignature', @fSignature, bObject);
  2097.         inherited Fields(DoToField);
  2098.     end;
  2099.  
  2100. {--------------------------------------------------------------------------------------------------}
  2101.  
  2102. {$S AInit}
  2103.  
  2104. procedure TNewWindow.FindSubviews;
  2105.     { Lookup all our subviews for later. }
  2106.  
  2107.     begin
  2108.         fInput := TTEView(FindSubView('Inpu'));
  2109.         fInput.fControlChars := fInput.fControlChars - [chReturn];
  2110.         fSpread := TButton(FindSubView('Spre'));
  2111.         fMonth := TPopup(FindSubView('Mont'));
  2112.         fDay := TPopup(FindSubView('Day '));
  2113.         fYear := TStaticText(FindSubView('Year'));
  2114.         fSignature := TStaticText(FindSubView('Sign'));
  2115.     end;
  2116.  
  2117. {--------------------------------------------------------------------------------------------------}
  2118.  
  2119. {$S ARes}
  2120.  
  2121. function TNewWindow.GetExpire: longInt;
  2122.     { Get the expiration date. }
  2123.  
  2124.     var dt: DateTimeRec;
  2125.         l: longInt;
  2126.  
  2127.     begin
  2128.         { Compute the expiration date (remember, we expire at 5AM). }
  2129.         Secs2Date(GetNow,dt);
  2130.         with dt do
  2131.             begin
  2132.                 month := fMonth.GetCurrentItem;
  2133.                 day := fDay.GetCurrentItem;
  2134.                 hour := 5;
  2135.                 minute := 0;
  2136.                 second := 0;
  2137.             end;
  2138.         Date2Secs(dt,l);
  2139.         if (l - GetNow) < 0 then
  2140.             begin
  2141.                 dt.year := dt.year+1;
  2142.                 Date2Secs(dt,l);
  2143.             end;
  2144.         GetExpire := l;
  2145.     end;
  2146.  
  2147. {--------------------------------------------------------------------------------------------------}
  2148.  
  2149. {$S ARes}
  2150.  
  2151. procedure TNewWindow.GetSetExpire;
  2152.     { Get and set the expiration date (corrects for odd month/day combinations, etc. }
  2153.  
  2154.     begin
  2155.         SetExpire(GetExpire);
  2156.     end;
  2157.  
  2158. {--------------------------------------------------------------------------------------------------}
  2159.  
  2160. {$S ARes}
  2161.  
  2162. procedure TNewWindow.GetSignature;
  2163.     { Figure out the current signature. }
  2164.  
  2165.     var ourDoc: TLACSDocument;
  2166.         s: Str255;
  2167.         zoneStr: Str32;
  2168.  
  2169.     begin
  2170.         ourDoc := TLACSDocument(fDocument);
  2171.         case ourDoc.fConfig.signature of
  2172.             kSignatureFromChooser: s := GetString(kChooserName)^^;
  2173.             kSignatureFromUser: s := ourDoc.fConfig.userSignature;
  2174.             otherwise s := '';
  2175.             end;
  2176.         if s <> '' then
  2177.             begin
  2178.                 zoneStr := ourDoc.fZoneLooker.fOurZone;
  2179.                 if zoneStr <> '' then s := Concat(s,' @ ',zoneStr);
  2180.             end;
  2181.         fSignature.SetText(s,true);
  2182.     end;
  2183.  
  2184. {--------------------------------------------------------------------------------------------------}
  2185.  
  2186. {$S ARes}
  2187.  
  2188. procedure TNewWindow.ResetExpire;
  2189.     { Reset the expiration date display. }
  2190.  
  2191.     var l: longInt;
  2192.         dt: DateTimeRec;
  2193.  
  2194.     begin
  2195.         Secs2Date(GetNow+TLACSDocument(fDocument).fConfig.expireIn,dt);
  2196.         Date2Secs(dt,l);
  2197.         SetExpire(l);
  2198.     end;
  2199.  
  2200. {--------------------------------------------------------------------------------------------------}
  2201.  
  2202. {$S ARes}
  2203.  
  2204. procedure TNewWindow.ResetIfExpired;
  2205.     { Reset the expiration date if the current one is expired. }
  2206.  
  2207.     begin
  2208.         if ExpireExpired then ResetExpire;
  2209.     end;
  2210.  
  2211. {--------------------------------------------------------------------------------------------------}
  2212.  
  2213. {$S ARes}
  2214.  
  2215. procedure TNewWindow.SetExpire(t: longInt);
  2216.     { Set the expiration date. }
  2217.  
  2218.     var dt: DateTimeRec;
  2219.         s: Str255;
  2220.  
  2221.     begin
  2222.         TLACSDocument(fDocument).fConfig.expireIn := t - GetNow;
  2223.         Secs2Date(t,dt);
  2224.         NumToString(dt.year,s);
  2225.         fMonth.SetCurrentItem(dt.month,true);
  2226.         fDay.SetCurrentItem(dt.day,true);
  2227.         fYear.SetText(Concat(', ',s),true);
  2228.     end;
  2229.  
  2230. {--------------------------------------------------------------------------------------------------}
  2231.  
  2232. {$S ARes}
  2233.  
  2234. procedure TStatusWindow.Bored;
  2235.     { Change status to "bored and idle..." }
  2236.  
  2237.     begin
  2238.         SetStatus(kStatBored);
  2239.     end;
  2240.  
  2241. {--------------------------------------------------------------------------------------------------}
  2242.  
  2243. {$S AFields}
  2244.  
  2245. procedure TStatusWindow.Fields(procedure DoToField(fieldName: Str255; fieldAddr: Ptr;
  2246.                                         fieldType: integer)); override;
  2247.  
  2248.     var i: integer;
  2249.  
  2250.     begin
  2251.         DoToField('TStatusWindow', nil, bClass);
  2252.         DoToField('fTotalMessages', @fTotalMessages, bObject);
  2253.         DoToField('fTotalPassed', @fTotalPassed, bObject);
  2254.         DoToField('fHotMessages', @fHotMessages, bObject);
  2255.         DoToField('fColdMessages', @fColdMessages, bObject);
  2256.         for i := 1 to kMaxNodes do
  2257.             DoToField(Concat('fGossipWith[',LongAsString(i),']'), @fGossipWith[i], bObject);
  2258.         DoToField('fStatus', @fStatus, bObject);
  2259.         DoToField('fLastStatusChange', @fLastStatusChange, bLongInt);
  2260.         inherited Fields(DoToField);
  2261.     end;
  2262.  
  2263. {--------------------------------------------------------------------------------------------------}
  2264.  
  2265. {$S AInit}
  2266.  
  2267. procedure TStatusWindow.FindSubviews;
  2268.     { Lookup all our subviews for later. }
  2269.  
  2270.     begin
  2271.         fTotalMessages := TNumberText(FindSubView('Tota'));
  2272.         fTotalPassed := TNumberText(FindSubView('Pass'));
  2273.         fHotMessages := TNumberText(FindSubView('HotR'));
  2274.         fColdMessages := TNumberText(FindSubView('Cold'));
  2275.         fGossipWith[1] := TStaticText(FindSubView('Gos1'));
  2276.         fGossipWith[2] := TStaticText(FindSubView('Gos2'));
  2277.         fGossipWith[3] := TStaticText(FindSubView('Gos3'));
  2278.         fGossipWith[4] := TStaticText(FindSubView('Gos4'));
  2279.         fGossipWith[5] := TStaticText(FindSubView('Gos5'));
  2280.         fGossipWith[6] := TStaticText(FindSubView('Gos6'));
  2281.         fGossipWith[7] := TStaticText(FindSubView('Gos7'));
  2282.         fGossipWith[8] := TStaticText(FindSubView('Gos8'));
  2283.         fGossipWith[9] := TStaticText(FindSubView('Gos9'));
  2284.         fGossipWith[10] := TStaticText(FindSubView('Gos0'));
  2285.         fStatus := TStaticText(FindSubView('Stat'));
  2286.     end;
  2287.  
  2288. {--------------------------------------------------------------------------------------------------}
  2289.  
  2290. {$S ARes}
  2291.  
  2292. procedure TStatusWindow.IncColdMessages(i: integer);
  2293.     { Increment the current cold messages count by i. }
  2294.  
  2295.     begin
  2296.         fColdMessages.SetValue(fColdMessages.GetValue+i,true);
  2297.     end;
  2298.  
  2299. {--------------------------------------------------------------------------------------------------}
  2300.  
  2301. {$S ARes}
  2302.  
  2303. procedure TStatusWindow.IncHotMessages(i: integer);
  2304.     { Increment the current hot messages count by i. }
  2305.  
  2306.     begin
  2307.         fHotMessages.SetValue(fHotMessages.GetValue+i,true);
  2308.     end;
  2309.  
  2310. {--------------------------------------------------------------------------------------------------}
  2311.  
  2312. {$S ARes}
  2313.  
  2314. procedure TStatusWindow.IncTotalPassed(i: integer);
  2315.     { Increment the total messages passed on count by i. }
  2316.  
  2317.     begin
  2318.         fTotalPassed.SetValue(fTotalPassed.GetValue+i,true);
  2319.     end;
  2320.  
  2321. {--------------------------------------------------------------------------------------------------}
  2322.  
  2323. {$S ARes}
  2324.  
  2325. procedure TStatusWindow.IncTotalMessages(i: integer);
  2326.     { Increment the total messages seen count by i. }
  2327.  
  2328.     begin
  2329.         fTotalMessages.SetValue(fTotalMessages.GetValue+i,true);
  2330.     end;
  2331.  
  2332. {--------------------------------------------------------------------------------------------------}
  2333.  
  2334. {$S ARes}
  2335.  
  2336. procedure TStatusWindow.SetStatus(statNum: integer);
  2337.     { Change the status display. }
  2338.  
  2339.     var s: Str255;
  2340.  
  2341.     begin
  2342.         fLastStatusChange := TickCount;
  2343.         GetIndString(s,kStatStrings,statNum);
  2344.         fStatus.SetText(s,true);
  2345.     end;
  2346.  
  2347. {--------------------------------------------------------------------------------------------------}
  2348.  
  2349. {$S ARes}
  2350.  
  2351. procedure TStatusWindow.UpdateGossipWith;
  2352.     { Update the display of who we're gossiping with. }
  2353.  
  2354.     var i: integer;
  2355.         n1: EntityName;
  2356.         nodeLooker: TNodeLookup;
  2357.  
  2358.     begin
  2359.         nodeLooker := TLACSDocument(fDocument).fNodeLooker;
  2360.         for i := 1 to nodeLooker.fNodeCount do
  2361.             begin
  2362.                 n1 := nodeLooker.fNodes[i];
  2363.                 with n1 do
  2364.                 if zoneStr = '*' then fGossipWith[i].SetText(objStr,true)
  2365.                 else fGossipWith[i].SetText(Concat(objStr,' @ ',zoneStr),true);
  2366.             end;
  2367.         for i := nodeLooker.fNodeCount + 1 to kMaxNodes do fGossipWith[i].SetText('',true);
  2368.     end;
  2369.  
  2370. {--------------------------------------------------------------------------------------------------}
  2371.  
  2372. {$S ARes}
  2373.  
  2374. function TMessageListView.DoMouseCommand(var theMouse: Point; var info: EventInfo;
  2375.                                                                     var hysteresis: Point): TCommand;
  2376.     { Handle mouse events. }
  2377.  
  2378.     var aRow, aCol: integer;
  2379.         r: TMessage;
  2380.  
  2381.     begin
  2382.         DoMouseCommand := gNoChanges;
  2383.     
  2384.         { Make sure this is a reasonable place to click. }
  2385.         if IdentifyPoint(theMouse, aRow, aCol) <> badChoice then
  2386.             begin
  2387.                 if aRow <= fList.fSize then
  2388.                     begin
  2389.                         { Get the corresponding message. }
  2390.                         r := TMessage(fList.At(aRow));
  2391.                         { Mark it as read, in case it isn't already. }
  2392.                         r.MarkAsRead;
  2393.                         { Display the full text. }
  2394.                         fList.fDocument.fMessagesWindow.DisplayMessage(r);
  2395.                     end;
  2396.             end;
  2397.     end;
  2398.  
  2399. {--------------------------------------------------------------------------------------------------}
  2400.  
  2401. {$S AFields}
  2402.  
  2403. procedure TMessageListView.Fields(procedure DoToField(fieldName: Str255; fieldAddr: Ptr;
  2404.                                         fieldType: integer)); override;
  2405.  
  2406.     begin
  2407.         DoToField('TMessageListView', nil, bClass);
  2408.         DoToField('fList', @fList, bObject);
  2409.         inherited Fields(DoToField);
  2410.     end;
  2411.  
  2412. {--------------------------------------------------------------------------------------------------}
  2413.  
  2414. {$S ARes}
  2415.  
  2416. procedure TMessageListView.GetItemText(anItem: integer; var aString: Str255);
  2417.     { Retrieve the text for a particular item. }
  2418.  
  2419.     var r: TMessage;
  2420.  
  2421.     begin
  2422.         r := TMessage(fList.At(anItem));
  2423.         if r = nil then aString := 'No items available...'
  2424.         else r.AsString(aString);
  2425.     end;
  2426.  
  2427. {--------------------------------------------------------------------------------------------------}
  2428.  
  2429. {$S ARes}
  2430.  
  2431. procedure TPeriodic.Activate;
  2432.     { Start a periodic activity. }
  2433.  
  2434.     begin
  2435.         { To be filled in by a subclass. }
  2436.     end;
  2437.  
  2438. {--------------------------------------------------------------------------------------------------}
  2439.  
  2440. {$S ARes}
  2441.  
  2442. function TPeriodic.DoIdle(phase: IdlePhase): boolean;
  2443.     { Internal method -- idle the object. }
  2444.  
  2445.     var fi: FailInfo;
  2446.  
  2447.     procedure hdlFailure(error: OSErr; message: LongInt);
  2448.         { If we fail, reset to inactive. }
  2449.  
  2450.         begin
  2451.             fState := kPeriodicInactive;
  2452.             fIdleFreq := fInactiveIdle;
  2453.             exit(DoIdle);
  2454.         end;
  2455.  
  2456.     begin
  2457.         DoIdle := false;
  2458.         if phase = IdleContinue then
  2459.             begin
  2460.                 CatchFailures(fi,hdlFailure);
  2461.                 { If we've just timed out, then activate the object. }
  2462.                 if fState = kPeriodicInactive then Activate
  2463.                 else
  2464.                     begin
  2465.                         { If we're waiting, see if we're done yet. }
  2466.                         if fState = kPeriodicWaiting then Waiting;
  2467.                         { If we're done, do something with the results. }
  2468.                         if fState = kPeriodicActive then DoIt;
  2469.                     end;
  2470.                 { Figure out the new idle frequency. }
  2471.                 if fState = kPeriodicInactive then fIdleFreq := fInactiveIdle
  2472.                 else fIdleFreq := fActiveIdle;
  2473.                 Success(fi);
  2474.             end;
  2475.     end;
  2476.  
  2477. {--------------------------------------------------------------------------------------------------}
  2478.  
  2479. {$S ARes}
  2480.  
  2481. procedure TPeriodic.DoIt;
  2482.     { Handle the results of an async operation. }
  2483.  
  2484.     begin
  2485.         { To be filled in by a subclass. }
  2486.     end;
  2487.  
  2488. {--------------------------------------------------------------------------------------------------}
  2489.  
  2490. {$S AFields}
  2491.  
  2492. procedure TPeriodic.Fields(procedure DoToField(fieldName: Str255; fieldAddr: Ptr;
  2493.                                         fieldType: integer)); override;
  2494.  
  2495.     var s: Str255;
  2496.  
  2497.     begin
  2498.         DoToField('TPeriodic', nil, bClass);
  2499.         DoToField('fInactiveIdle', @fInactiveIdle, bLongInt);
  2500.         DoToField('fActiveIdle', @fActiveIdle, bLongInt);
  2501.         if fState = kPeriodicInactive then s := 'kPeriodicInactive'
  2502.         else if fState = kPeriodicWaiting then s := 'kPeriodicWaiting'
  2503.         else s := 'kPeriodicActive';
  2504.         DoToField('fState', @s, bString);
  2505.         inherited Fields(DoToField);
  2506.     end;
  2507.  
  2508. {--------------------------------------------------------------------------------------------------}
  2509.  
  2510. {$S ARes}
  2511.  
  2512. procedure TPeriodic.Free;
  2513.     { Free the object. }
  2514.  
  2515.     begin
  2516.         { First wait for any outstanding operation to complete. }
  2517.         while fState = kPeriodicWaiting do Waiting;
  2518.         { Deinstall ourselves from the co-handler chain. }
  2519.         gApplication.InstallCohandler(self,false);
  2520.         { Free ourselves. }
  2521.         inherited Free;
  2522.     end;
  2523.  
  2524. {--------------------------------------------------------------------------------------------------}
  2525.  
  2526. {$S ARes}
  2527.  
  2528. procedure TPeriodic.IPeriodic(initialIdle, inactiveIdle, activeIdle: longInt);
  2529.     { Initialize the object. }
  2530.  
  2531.     begin
  2532.         IEvtHandler(nil);
  2533.         fIdleFreq := initialIdle;
  2534.         fInactiveIdle := inactiveIdle;
  2535.         fActiveIdle := activeIdle;
  2536.         fState := kPeriodicInactive;
  2537.         { Install the object in the co-handler chain. }
  2538.         gApplication.InstallCohandler(self,true);
  2539.     end;
  2540.  
  2541. {--------------------------------------------------------------------------------------------------}
  2542.  
  2543. {$S ARes}
  2544.  
  2545. procedure TPeriodic.Kick;
  2546.     { Start things up even if it isn't normally time yet. }
  2547.  
  2548.     begin
  2549.         fIdleFreq := 0;
  2550.     end;
  2551.  
  2552. {--------------------------------------------------------------------------------------------------}
  2553.  
  2554. {$S ARes}
  2555.  
  2556. procedure TPeriodic.Waiting;
  2557.     { Test for async completion. }
  2558.  
  2559.     begin
  2560.         { To be filled in by a subclass. }
  2561.     end;
  2562.  
  2563. {--------------------------------------------------------------------------------------------------}
  2564.  
  2565. {$S ARes}
  2566.  
  2567. procedure TPssst.Activate;
  2568.     { Update the about box. }
  2569.  
  2570.     var ignore: OSErr;
  2571.  
  2572.     procedure psstIt(i: TIcon);
  2573.         { Update one icon. }
  2574.  
  2575.         begin
  2576.             { Only do it if we've got the right kind of view. }
  2577.             if Member(i,TIcon) then
  2578.                 begin
  2579.                     { Toggle randomly between "pssst" and no "pssst". }
  2580.                     if (i.fRsrcID = kPsstHead) and (BAnd(Random,63) = 0) then
  2581.                         begin
  2582.                             i.SetIcon(GetIcon(kNoPsstHead),true);
  2583.                             i.fRsrcID := kNoPsstHead;
  2584.                         end
  2585.                     else if (i.fRsrcID = kNoPsstHead) and (BAnd(Random,63) = 0) then
  2586.                         begin
  2587.                             i.SetIcon(GetIcon(kPsstHead),true);
  2588.                             i.fRsrcID := kPsstHead;
  2589.                         end;
  2590.                 end;
  2591.         end;
  2592.  
  2593.     begin
  2594.         { For each balloon, update the view. }
  2595.         if gAboutWindow.IsShown then gAboutWindow.EachSubView(psstIt);
  2596.     end;
  2597.  
  2598. {--------------------------------------------------------------------------------------------------}
  2599.  
  2600. {$S ARes}
  2601.  
  2602. procedure TMessagesExpirator.Activate;
  2603.     { Expire messages. }
  2604.  
  2605.     begin
  2606.         { First, kill of notify if present. }
  2607.         if not gInBackground then fDocument.fMessagesWindow.KillNotify;
  2608.         { Second, reset the expiration date in the New window. }
  2609.         fDocument.fNewWindow.ResetIfExpired;
  2610.         { Third, expire messages. }
  2611.         fDocument.ExpireMessages;
  2612.         { Forth, if enough time has gone by, reset status to "bored and idle..." }
  2613.         if (TickCount-fDocument.fStatusWindow.fLastStatusChange) > kStatusBoredRate then
  2614.             fDocument.fStatusWindow.Bored;
  2615.     end;
  2616.  
  2617. {--------------------------------------------------------------------------------------------------}
  2618.  
  2619. {$S AFields}
  2620.  
  2621. procedure TMessagesExpirator.Fields(procedure DoToField(fieldName: Str255; fieldAddr: Ptr;
  2622.                                         fieldType: integer)); override;
  2623.  
  2624.     begin
  2625.         DoToField('TMessagesExpirator', nil, bClass);
  2626.         DoToField('fDocument', @fDocument, bObject);
  2627.         inherited Fields(DoToField);
  2628.     end;
  2629.  
  2630. {--------------------------------------------------------------------------------------------------}
  2631.  
  2632. {$S ARes}
  2633.  
  2634. procedure TMessagesExpirator.IMessagesExpirator(aDoc: TLACSDocument; 
  2635.                                                                             initialIdle, inactiveIdle, activeIdle: longInt);
  2636.     { Initialize message expirer. }
  2637.  
  2638.     begin
  2639.         IPeriodic(initialIdle,inactiveIdle,activeIdle);
  2640.         fDocument := aDoc;
  2641.     end;
  2642.  
  2643. {--------------------------------------------------------------------------------------------------}
  2644.  
  2645. {$S ARes}
  2646.  
  2647. procedure TDocumentSaver.Activate;
  2648.     { Get ready to save. }
  2649.  
  2650.     begin
  2651.         fState := kPeriodicWaiting;
  2652.     end;
  2653.  
  2654. {--------------------------------------------------------------------------------------------------}
  2655.  
  2656. {$S ARes}
  2657.  
  2658. procedure TDocumentSaver.DoIt;
  2659.     { Save the document. }
  2660.  
  2661.     begin
  2662.         fDocument.Save(cSave,false,false);
  2663.         fState := kPeriodicInactive;
  2664.     end;
  2665.  
  2666. {--------------------------------------------------------------------------------------------------}
  2667.  
  2668. {$S AFields}
  2669.  
  2670. procedure TDocumentSaver.Fields(procedure DoToField(fieldName: Str255; fieldAddr: Ptr;
  2671.                                         fieldType: integer)); override;
  2672.  
  2673.     begin
  2674.         DoToField('TDocumentSaver', nil, bClass);
  2675.         DoToField('fDocument', @fDocument, bObject);
  2676.         inherited Fields(DoToField);
  2677.     end;
  2678.  
  2679. {--------------------------------------------------------------------------------------------------}
  2680.  
  2681. {$S ARes}
  2682.  
  2683. procedure TDocumentSaver.IDocumentSaver(aDoc: TLACSDocument; 
  2684.                                                                             initialIdle, inactiveIdle, activeIdle: longInt);
  2685.     { Initialize the document saver. }
  2686.  
  2687.     begin
  2688.         IPeriodic(initialIdle,inactiveIdle,activeIdle);
  2689.         fDocument := aDoc;
  2690.     end;
  2691.  
  2692. {--------------------------------------------------------------------------------------------------}
  2693.  
  2694. {$S ARes}
  2695.  
  2696. procedure TDocumentSaver.Waiting;
  2697.     { Wait until we're in the foreground. }
  2698.  
  2699.     begin
  2700.         if not gInBackground then fState := kPeriodicActive;
  2701.     end;
  2702.  
  2703. {--------------------------------------------------------------------------------------------------}
  2704.  
  2705. {$S ARes}
  2706.  
  2707. procedure TZoneLookup.Activate;
  2708.     { Start a zone list lookup. }
  2709.  
  2710.     var addrBlock: AddrBlock;
  2711.         ignore: integer;
  2712.         s: Str255;
  2713.  
  2714.     begin
  2715.         { Let the user know what we're doing. }
  2716.         fDocument.fStatusWindow.SetStatus(kStatZoneUpdate);
  2717.         { Clear out the zone list. }
  2718.         fZoneCount := 0;
  2719.         { Get our zone name. }
  2720.         with fXPPPBPtr^ do
  2721.             begin
  2722.                 ioRefNum := xppRefNum;        { Driver refNum -41. }
  2723.                 csCode := xCall;
  2724.                 xppSubCode := zipGetMyZone;
  2725.                 zipBuffPtr := @s;
  2726.                 zipInfoField[1] := 0;        { ALWAYS 0. }
  2727.                 zipInfoField[2] := 0;        { ALWAYS 0. }
  2728.             end;
  2729.         { Send the getMyZone request synchronously (and cross our electronic fingers it doesn't take long). }
  2730.         if PBControl(ParmBlkPtr(fXPPPBPtr), false) <> noErr then fState := kPeriodicInactive
  2731.         else
  2732.             begin
  2733.                 { Update the display to reflect any changes. }
  2734.                 if (s <> fOurZone) and (s <> '') then
  2735.                     begin
  2736.                         fOurZone := s;
  2737.                         fDocument.fNewWindow.GetSignature;
  2738.                     end;
  2739.                 { Now make a getZoneList request. }
  2740.                 with fXPPPBPtr^ do
  2741.                     begin
  2742.                         zipInfoField[1] := 0;            { ALWAYS 0 on first call; contains state info on subsequent calls. }
  2743.                         zipInfoField[2] := 0;            { ALWAYS 0 on first call; contains state info on subsequent calls. }
  2744.                         ioRefNum := XPPRefNum;    { Driver refNum -41. }
  2745.                         csCode := xCall;
  2746.                         xppSubCode := zipGetZoneList;
  2747.                         xppTimeOut := kXPPTimeOutVal;
  2748.                         xppRetry := kXPPRetryCount;
  2749.                         zipBuffPtr := Ptr(fZonesBuffer);    { This buffer will be filled with packed zone names. }
  2750.                         zipLastFlag := 0;
  2751.                     end;
  2752.                 { Send off the request. }
  2753.                 ignore := PBControl(ParmBlkPtr(fXPPPBPtr), true);
  2754.                 fState := kPeriodicWaiting;
  2755.             end;
  2756.     end;
  2757.  
  2758. {--------------------------------------------------------------------------------------------------}
  2759.  
  2760. {$S ARes}
  2761.  
  2762. procedure TZoneLookup.DoIt;
  2763.     { Process returned zone list. }
  2764.  
  2765.     var  dCount: integer;
  2766.         dCurr: Ptr;
  2767.         ignore: OSErr;
  2768.  
  2769.     begin
  2770.         { Cycle through the returned list. }
  2771.         dCount := fXPPPBPtr^.zipNumZones;                                    { Find out how many returned. }
  2772.         dCurr := fZonesBuffer;                                                        { Put current pointer at start. }
  2773.         while (fZoneCount < kMaxZones) and (dCount > 0) do            { Get each zone. }
  2774.             begin
  2775.                 fZoneCount := fZoneCount+1;
  2776.                 fZones[fZoneCount][0] := chr(dCurr^);
  2777.                 BlockMove(pointer(ord4(dCurr)+1),pointer(ord4(@fZones[fZoneCount])+1),dCurr^);
  2778.                 dCurr := pointer(ord4(dCurr) + dCurr^+1);                { Bump up current pointer. }
  2779.                 dCount := dCount-1;
  2780.             end;
  2781.         { If there are more to come, do another request. }
  2782.         if (fZoneCount < kMaxZones) and (fXPPPBPtr^.zipLastFlag = 0) then
  2783.             begin
  2784.                 ignore := PBControl(ParmBlkPtr(fXPPPBPtr), true);
  2785.                 fState := kPeriodicWaiting;
  2786.             end
  2787.         { Otherwise, we're all done. }
  2788.         else fState := kPeriodicInactive;
  2789.     end;
  2790.  
  2791. {--------------------------------------------------------------------------------------------------}
  2792.  
  2793. {$S ARes}
  2794.  
  2795. function TZoneLookup.GetRandomZone: Str32;
  2796.     { Pick a random zone from the list and return it. }
  2797.  
  2798.     begin
  2799.         { If there are no zones in the list, then return the local zone. }
  2800.         if (fZoneCount = 0) or ((abs(Random) mod fDocument.fConfig.inZoneSearch) = 0) then GetRandomZone := '*'
  2801.         { Otherwise, return a random zone from the zone list. }
  2802.         else GetRandomZone := fZones[abs(Random) mod fZoneCount + 1];
  2803.     end;
  2804.  
  2805. {--------------------------------------------------------------------------------------------------}
  2806.  
  2807. {$S AFields}
  2808.  
  2809. procedure TZoneLookup.Fields(procedure DoToField(fieldName: Str255; fieldAddr: Ptr;
  2810.                                         fieldType: integer)); override;
  2811.  
  2812.     var p: Ptr;
  2813.  
  2814.     begin
  2815.         DoToField('TZoneLookup', nil, bClass);
  2816.         DoToField('fDocument', @fDocument, bObject);
  2817.         DoToField('fZoneCount', @fZoneCount, bInteger);
  2818.         DoToField('fXPPPBPtr', @fXPPPBPtr, bPointer);
  2819.         DoToField('fZonesBuffer', @fZonesBuffer, bPointer);
  2820.         DoToField('fOurZone',@fOurZone,bString);
  2821.         p := @fZones;
  2822.         DoToField('fZones', @p, bPointer);
  2823.         inherited Fields(DoToField);
  2824.     end;
  2825.  
  2826. {--------------------------------------------------------------------------------------------------}
  2827.  
  2828. {$S ARes}
  2829.  
  2830. procedure TZoneLookup.Free;
  2831.     { Free the zone lookup object. }
  2832.  
  2833.     begin
  2834.         DisposPtr(Ptr(fXPPPBPtr));
  2835.         DisposPtr(fZonesBuffer);
  2836.         inherited Free;
  2837.     end;
  2838.  
  2839. {--------------------------------------------------------------------------------------------------}
  2840.  
  2841. {$S ARes}
  2842.  
  2843. procedure TZoneLookup.IZoneLookup(aDoc: TLACSDocument; initialIdle, inactiveIdle, activeIdle: longInt);
  2844.     { Initialize the zone lookup object. }
  2845.  
  2846.     begin
  2847.         IPeriodic(initialIdle,inactiveIdle,activeIdle);
  2848.         fDocument := aDoc;
  2849.         fOurZone := '';
  2850.         fZoneCount := 0;
  2851.         { Allocate memory blocks we'll need later. }
  2852.         fXPPPBPtr := xCallPtr(NewPtr(sizeof(xCallParam)));
  2853.         FailNil(fXPPPBPtr);
  2854.         fZonesBuffer := NewPtr(kZonesBufferSize);
  2855.         FailNil(fZonesBuffer);
  2856.     end;
  2857.  
  2858. {--------------------------------------------------------------------------------------------------}
  2859.  
  2860. {$S ARes}
  2861.  
  2862. procedure TZoneLookup.Waiting;
  2863.     { Wait for the zone lookup to complete. }
  2864.  
  2865.     begin
  2866.         if fXPPPBPtr^.ioResult = noErr then fState := kPeriodicActive
  2867.         else if fXPPPBPtr^.ioResult < noErr then fState := kPeriodicInactive;
  2868.     end;
  2869.  
  2870. {--------------------------------------------------------------------------------------------------}
  2871.  
  2872. {$S ARes}
  2873.  
  2874. procedure TNodeLookup.Activate;
  2875.     { Start a node lookup. }
  2876.  
  2877.     var addrBlock: AddrBlock;
  2878.         ignore: integer;
  2879.         theZone: Str32;
  2880.  
  2881.     begin
  2882.         { Let the user know what's going on. }
  2883.         fDocument.fStatusWindow.SetStatus(kStatNodeUpdate);
  2884.         { Pick a zone to look in. }
  2885.         theZone := fDocument.fZoneLooker.GetRandomZone;
  2886.         fZone := theZone;
  2887.         { Build a lookup request. }
  2888.         NBPSetEntity(fNameBuffer,'=',kLACS,theZone);
  2889.         with fpBlock^ do
  2890.             begin
  2891.                 ioCompletion := nil;
  2892.                 interval := kNBPTimeOutVal;
  2893.                 count := kNBPRetryCount;
  2894.                 entityPtr := fNameBuffer;
  2895.                 retBuffPtr := fLookupBuf;
  2896.                 retBuffSize := kLookupBufferSize;
  2897.                 maxToGet := kMaxLookupNames;
  2898.                 numGotten := 0;
  2899.             end;
  2900.         { Do the lookup. }
  2901.         ignore := PLookupName(fpBlock,true);
  2902.         fState := kPeriodicWaiting;
  2903.     end;
  2904.  
  2905. {--------------------------------------------------------------------------------------------------}
  2906.  
  2907. {$S ARes}
  2908.  
  2909. procedure TNodeLookup.DoIt;
  2910.     { Process the results of a node lookup. }
  2911.  
  2912.     var doNodeUpdate: boolean;
  2913.         doShortNodeUpdate: boolean;
  2914.         name: EntityName;
  2915.         addr: AddrBlock;
  2916.         i: integer;
  2917.  
  2918.     begin
  2919.         { Check if we got any results at all. }
  2920.         if fpBlock^.numGotten > 0 then
  2921.             begin
  2922.                 { If so, get the name. }
  2923.                 FailOSErr(NBPExtract(fLookupBuf,fpBlock^.numGotten,abs(Random) mod fpBlock^.numGotten + 1,
  2924.                                 name,addr));
  2925.                 { Get the zone from our own records. }
  2926.                 name.zoneStr := fZone;
  2927.                 doNodeUpdate := true;
  2928.                 { Check if we've found ourselves. }
  2929.                 if (name.objStr = GetString(kChooserName)^^) and (name.zoneStr = '*') then doNodeUpdate := false
  2930.                 { Otherwise, check if we've found a node we already had in the list. }
  2931.                 else
  2932.                     for i := 1 to fNodeCount do
  2933.                         if (name.objStr = fNodes[i].objStr) and (name.zoneStr = fNodes[i].zoneStr) then
  2934.                             begin
  2935.                                 doNodeUpdate := false;
  2936.                                 leave;
  2937.                             end;
  2938.                 { If we've really got a new node to add in... }
  2939.                 if doNodeUpdate then
  2940.                     begin
  2941.                         { Figure out where to add it (extend the list or replace an existing entry). }
  2942.                         if fNodeCount < kMaxNodes then
  2943.                             begin
  2944.                                 fNodeCount := fNodeCount + 1;
  2945.                                 i := fNodeCount;
  2946.                             end
  2947.                         else i := abs(Random) mod kMaxNodes + 1;
  2948.                         { Save the new node. }
  2949.                         fNodes[i] := name;
  2950.                         fAddrs[i] := addr;
  2951.                         { Update the display for the user. }
  2952.                         fDocument.fStatusWindow.UpdateGossipWith;
  2953.                     end;
  2954.             end;
  2955.         { Decide if we should be doing a short or long time-out. }
  2956.         doShortNodeUpdate := false;
  2957.         if fNodeCount = 0 then doShortNodeUpdate := true
  2958.         else
  2959.             begin
  2960.                 doShortNodeUpdate := true;
  2961.                 for i := 1 to fNodeCount do
  2962.                     if fNodes[i].zoneStr <> '*' then doShortNodeUpdate := false;
  2963.             end;
  2964.         { Set up the new time-out. }
  2965.         if doShortNodeUpdate then fInactiveIdle := fFastIdle
  2966.         else fInactiveIdle := fSlowIdle;
  2967.         fState := kPeriodicInactive;
  2968.     end;
  2969.  
  2970. {--------------------------------------------------------------------------------------------------}
  2971.  
  2972. {$S AFields}
  2973.  
  2974. procedure TNodeLookup.Fields(procedure DoToField(fieldName: Str255; fieldAddr: Ptr;
  2975.                                         fieldType: integer)); override;
  2976.  
  2977.     var p: Ptr;
  2978.  
  2979.     begin
  2980.         DoToField('TNodeLookup', nil, bClass);
  2981.         DoToField('fDocument', @fDocument, bObject);
  2982.         DoToField('fSlowIdle', @fSlowIdle, bLongInt);
  2983.         DoToField('fFastIdle', @fFastIdle, bLongInt);
  2984.         DoToField('fNodeCount', @fNodeCount, bInteger);
  2985.         DoToField('fNameBuffer', @fNameBuffer, bPointer);
  2986.         DoToField('fZone', @fZone, bString);
  2987.         DoToField('fpBlock', @fpBlock, bPointer);
  2988.         p := @fNodes;
  2989.         DoToField('fNodes', @p, bPointer);
  2990.         p := @fAddrs;
  2991.         DoToField('fAddrs', @p, bPointer);
  2992.         inherited Fields(DoToField);
  2993.     end;
  2994.  
  2995. {--------------------------------------------------------------------------------------------------}
  2996.  
  2997. {$S ARes}
  2998.  
  2999. procedure TNodeLookup.Free;
  3000.     { Free the node lookup object. }
  3001.  
  3002.     begin
  3003.         { Free our buffers and IO blocks. }
  3004.         DisposPtr(fNameBuffer);
  3005.         DisposPtr(Ptr(fpBlock));
  3006.         DisposPtr(fLookupBuf);
  3007.         { Free ourself. }
  3008.         inherited Free;
  3009.     end;
  3010.  
  3011. {--------------------------------------------------------------------------------------------------}
  3012.  
  3013. {$S ARes}
  3014.  
  3015. function TNodeLookup.GetRandomNode(var addr: AddrBlock): boolean;
  3016.     { Pick a random node from the list and return it. GetRandomNode itself returns true if we had a node to return. }
  3017.  
  3018.     var i: integer;
  3019.  
  3020.     begin
  3021.         GetRandomNode := false;
  3022.         { It only works if there are any nodes to pick from. }
  3023.         if fNodeCount > 0 then
  3024.             begin
  3025.                 { Pick a node to return. }
  3026.                 i := abs(Random) mod fNodeCount + 1;
  3027.                 { Build a confirm query. }
  3028.                 with fpBlock^ do
  3029.                     begin
  3030.                         ioCompletion := nil;
  3031.                         interval := kNBPTimeOutVal;
  3032.                         count := kNBPRetryCount;
  3033.                         with fNodes[i] do NBPSetEntity(fNameBuffer,objStr,typeStr,zoneStr);
  3034.                         entityPtr := fNameBuffer;
  3035.                         confirmAddr := fAddrs[i];
  3036.                         addr := confirmAddr;
  3037.                     end;
  3038.                 { Confirm that the node's still there. }
  3039.                 if PConfirmName(fpBlock,false) = noErr then GetRandomNode := true
  3040.                 { Otherwise, remove it form the list. }
  3041.                 else
  3042.                     begin
  3043.                         BlockMove(Ptr(ord4(@fNodes)+i*sizeof(EntityName)),
  3044.                                             Ptr(ord4(@fNodes)+(i-1)*sizeof(EntityName)),
  3045.                                             (fNodeCount-i)*sizeof(EntityName));
  3046.                         BlockMove(Ptr(ord4(@fAddrs)+i*sizeof(AddrBlock)),
  3047.                                             Ptr(ord4(@fAddrs)+(i-1)*sizeof(AddrBlock)),
  3048.                                             (fNodeCount-i)*sizeof(AddrBlock));
  3049.                         fNodeCount := fNodeCount-1;
  3050.                         fDocument.fStatusWindow.UpdateGossipWith;
  3051.                     end;
  3052.             end;
  3053.     end;
  3054.  
  3055. {--------------------------------------------------------------------------------------------------}
  3056.  
  3057. {$S ARes}
  3058.  
  3059. procedure TNodeLookup.INodeLookup(aDoc: TLACSDocument; initialIdle, fastIdle, slowIdle, activeIdle: longInt);
  3060.     { Initialize the node lookup object. }
  3061.  
  3062.     begin
  3063.         IPeriodic(initialIdle,slowIdle,activeIdle);
  3064.         fDocument := aDoc;
  3065.         fSlowIdle := slowIdle;
  3066.         fFastIdle := fastIdle;
  3067.         fNodeCount := 0;
  3068.         { Allocate buffers and IO blocks for later. }
  3069.         fNameBuffer := NewPtr(100);
  3070.         FailNil(fNameBuffer);
  3071.         fpBlock := MPPPBPtr(NewPtr(sizeof(MPPParamBlock)));
  3072.         FailNil(fpBlock);
  3073.         fLookupBuf := NewPtr(kLookupBufferSize);
  3074.         FailNil(fLookupBuf);
  3075.     end;
  3076.  
  3077. {--------------------------------------------------------------------------------------------------}
  3078.  
  3079. {$S ARes}
  3080.  
  3081. procedure TNodeLookup.Waiting;
  3082.     { Wait for a node lookup to complete. }
  3083.  
  3084.     begin
  3085.         if fpBlock^.ioResult = noErr then fState := kPeriodicActive
  3086.         else if fpBlock^.ioResult < noErr then fState := kPeriodicInactive;
  3087.     end;
  3088.  
  3089. {--------------------------------------------------------------------------------------------------}
  3090.  
  3091. {$S ARes}
  3092.  
  3093. procedure TGossip.Activate;
  3094.     { Start a new gossip session (outgoing only). }
  3095.  
  3096.     var addr: AddrBlock;
  3097.         r: TMessage;
  3098.         ignore: OSErr;
  3099.  
  3100.     begin
  3101.         { Only initiate a session if we're outgoing -- actually, Activate should never get called if we're not, but,
  3102.             hey, I'm paranoid, what can I tell ya? }
  3103.         fState := kPeriodicInactive;
  3104.         if fOutgoing then
  3105.             begin
  3106.                 { Get a node to gossip with. }
  3107.                 if fDocument.fNodeLooker.GetRandomNode(addr) then
  3108.                     begin
  3109.                         { Let the user know what's happening. }
  3110.                         fDocument.fStatusWindow.SetStatus(kStatGossiping);
  3111.                         { Get a message to spread. }
  3112.                         r := fDocument.GetHotMessage;
  3113.                         if r <> nil then
  3114.                             if not r.fForward then r := nil;
  3115.                         { Decide if we have anything to spread or not. }
  3116.                         if fDocument.fConfig.pull or (r <> nil) or (fDocument.fConfig.pullOnLess > fDocument.fMessages.fSize) then
  3117.                             begin
  3118.                                 { Build an ADSP session open request. }
  3119.                                 with fADSP^ do
  3120.                                     begin
  3121.                                         { Issue an active open command. }
  3122.                                         remoteAddress := addr;
  3123.                                         filterAddress := AddrBlock(0);
  3124.                                         ocMode := ocRequest;
  3125.                                         ocInterval := 0;
  3126.                                         ocMaximum := 0;
  3127.                                         csCode := dspOpen;
  3128.                                     end;
  3129.                                 { Open an ADSP session. }
  3130.                                 ignore := PBControl(ParmBlkPtr(fADSP),true);
  3131.                                 fDidPull := false;
  3132.                                 fState := kPeriodicWaiting;
  3133.                             end;
  3134.                     end;
  3135.             end;
  3136.     end;
  3137.  
  3138. {--------------------------------------------------------------------------------------------------}
  3139.  
  3140. {$S ARes}
  3141.  
  3142. procedure TGossip.DoIt;
  3143.     { Handle new input. }
  3144.  
  3145.     var r: TMessage;
  3146.         p: Ptr;
  3147.         noGood: boolean;
  3148.  
  3149.     begin
  3150.         noGood := false;
  3151.         { If this is a session open and we're the initiator... }
  3152.         if (fADSP^.csCode = dspOpen) and fOutgoing then
  3153.             begin
  3154.                 { Get a message to send. }
  3155.                 r := fDocument.GetHotMessage;
  3156.                 if r <> nil then
  3157.                     if not r.fForward then r := nil;
  3158.                 { Decide if we've something worth sending. }
  3159.                 if fDocument.fConfig.pull or (r <> nil) or (fDocument.fConfig.pullOnLess > fDocument.fMessages.fSize) then
  3160.                     begin
  3161.                         { Generate the appropriate send request. }
  3162.                         with fADSP^ do
  3163.                             begin
  3164.                                 p := fADSPData;
  3165.                                 if fDocument.fConfig.pullOnLess > fDocument.fMessages.fSize then reqCount := BuildPullCold(p)
  3166.                                 else if fDocument.fConfig.pull then
  3167.                                     begin
  3168.                                         reqCount := BuildPull(p);
  3169.                                         fDidPull := true;
  3170.                                     end
  3171.                                 else reqCount := r.BuildMessageCommand(p);
  3172.                                 dataPtr := fADSPData;
  3173.                                 eom := 1;
  3174.                                 flush := 1;
  3175.                                 csCode := dspWrite;
  3176.                             end;
  3177.                         { Send it. }
  3178.                         if PBControl(ParmBlkPtr(fADSP),true) <> noErr then noGood := true;
  3179.                     end
  3180.                 else noGood := true;
  3181.             end
  3182.         { If this is a completed read... }
  3183.         else if fADSP^.csCode = dspRead then
  3184.             begin
  3185.                 { Handle the incoming command, and build a reply if approriate. }
  3186.                 with fADSP^ do
  3187.                     begin
  3188.                         reqCount := fDocument.HandleIncomingCommand(fADSPData,fADSP^.actCount);
  3189.                         if (reqCount = 0) and fOutgoing and (not fDidPull) then
  3190.                             begin
  3191.                                 reqCount := BuildPull(fADSPData);
  3192.                                 fDidPull := true;
  3193.                             end;
  3194.                         dataPtr := fADSPData;
  3195.                         eom := 1;
  3196.                         flush := 1;
  3197.                         csCode := dspWrite;
  3198.                     end;
  3199.                 { If there's a reply, send it. }
  3200.                 if fADSP^.reqCount > 0 then
  3201.                     begin
  3202.                         if PBControl(ParmBlkPtr(fADSP),true) <> noErr then noGood := true;
  3203.                     end
  3204.                 else noGood := true;
  3205.             end
  3206.         { Otherwise... }
  3207.         else
  3208.             begin
  3209.                 { Start up a receive. }
  3210.                 with fADSP^ do
  3211.                     begin
  3212.                         dataPtr := fADSPData;
  3213.                         reqCount := kADSPMaxCommand;
  3214.                         csCode := dspRead;
  3215.                     end;
  3216.                 if PBControl(ParmBlkPtr(fADSP),true) <> noErr then noGood := true;
  3217.             end;
  3218.         { If we're all done, reset the connection. }
  3219.         if noGood then ResetConnection
  3220.         { Otherwise, wait for the results. }
  3221.         else fState := kPeriodicWaiting;
  3222.     end;
  3223.  
  3224. {--------------------------------------------------------------------------------------------------}
  3225.  
  3226. {$S AFields}
  3227.  
  3228. procedure TGossip.Fields(procedure DoToField(fieldName: Str255; fieldAddr: Ptr;
  3229.                                         fieldType: integer));
  3230.  
  3231.     begin
  3232.         DoToField('TGossip', nil, bClass);
  3233.         DoToField('fDocument', @fDocument, bObject);
  3234.         DoToField('fOutgoing', @fOutgoing, bBoolean);
  3235.         DoToField('fDidPull', @fDidPull, bBoolean);
  3236.         DoToField('fADSPSocket', @fADSPSocket, bInteger);
  3237.         DoToField('fADSP', @fADSP, bPointer);
  3238.         DoToField('fCcbPtr', @fCcbPtr, bPointer);
  3239.         DoToField('fSendQueue', @fSendQueue, bPointer);
  3240.         DoToField('fRecvQueue', @fRecvQueue, bPointer);
  3241.         DoToField('fAttnPtr', @fAttnPtr, bPointer);
  3242.         DoToField('fADSPData', @fADSPData, bPointer);
  3243.         DoToField('fNTE', @fNTE, bPointer);
  3244.         inherited Fields(DoToField);
  3245.     end;
  3246.  
  3247. {--------------------------------------------------------------------------------------------------}
  3248.  
  3249. {$S ARes}
  3250.  
  3251. procedure TGossip.Free;
  3252.     { Free the gossip object. }
  3253.  
  3254.     var pBlock: MPPParamBlock;
  3255.         io: DSPParamBlock;
  3256.         ignore: OSErr;
  3257.  
  3258.     begin
  3259.         { Remove the names table entry. }
  3260.         if not fOutgoing then
  3261.             begin
  3262.                 pBlock.entityPtr := Ptr(ord4(@fNTE^.nteData)+1);
  3263.                 ignore := PRemoveName(@pBlock,false);
  3264.             end;
  3265.         { Get rid of the ADSP connection. }
  3266.         io := fADSP^;
  3267.         io.abort := 1;
  3268.         io.csCode := dspRemove;
  3269.         ignore := PBControl(@io,false);
  3270.         { Dispose our buffers and IO blocks. }
  3271.         DisposPtr(fCcbPtr);
  3272.         DisposPtr(fSendQueue);
  3273.         DisposPtr(fRecvQueue);
  3274.         DisposPtr(fAttnPtr);
  3275.         DisposPtr(Ptr(fADSP));
  3276.         DisposPtr(fADSPData);
  3277.         fState := kPeriodicInactive;
  3278.         inherited Free;
  3279.     end;
  3280.  
  3281. {--------------------------------------------------------------------------------------------------}
  3282.  
  3283. {$S ARes}
  3284.  
  3285. procedure TGossip.IGossip(aDoc: TLACSDocument; outgoing: boolean; initialIdle, inactiveIdle, activeIdle: longInt);
  3286.     { Initialize the gossip object. }
  3287.  
  3288.     var pBlock: MPPParamBlock;
  3289.         s: Str255;
  3290.  
  3291.     begin
  3292.         IPeriodic(initialIdle,inactiveIdle,activeIdle);
  3293.         fDocument := aDoc;
  3294.         fOutgoing := outgoing;
  3295.  
  3296.         { Allocate buffers and IO blocks. }
  3297.         fADSP := DSPPBPtr(NewPtr(sizeof(DSPParamBlock)));
  3298.         FailNil(fADSP);
  3299.         fADSPData := NewPtr(kADSPMaxCommand);
  3300.         FailNil(fADSPData);
  3301.  
  3302.         { Fill in the ADSP IO block. }
  3303.         with fADSP^ do
  3304.             begin
  3305.                 ioCRefNum := gADSP;
  3306.                 ioCompletion := nil;
  3307.                 ccbPtr := TPCCB(NewPtr(sizeof(TRCCB)));
  3308.                 FailNil(ccbPtr);
  3309.                 fCcbPtr := Ptr(ccbPtr);
  3310.                 userRoutine := nil;
  3311.                 sendQSize := kADSPSendBufSize;
  3312.                 sendQueue := NewPtr(kADSPSendBufSize);
  3313.                 FailNil(sendQueue);
  3314.                 fSendQueue := sendQueue;
  3315.                 recvQSize := kADSPRecvBufSize;
  3316.                 recvQueue := NewPtr(kADSPRecvBufSize);
  3317.                 FailNil(recvQueue);
  3318.                 fRecvQueue := recvQueue;
  3319.                 attnPtr := NewPtr(attnBufSize);
  3320.                 FailNil(attnPtr);
  3321.                 fAttnPtr := attnPtr;
  3322.                 localSocket := 0;
  3323.                 csCode := dspInit;
  3324.             end;
  3325.         FailOSErr(PBControl(ParmBlkPtr(fADSP),false));
  3326.         fADSPSocket := fADSP^.localSocket;
  3327.  
  3328.         { If we're incoming, do a passive open and register us on NBP. }
  3329.         if not fOutgoing then
  3330.             begin
  3331.                 PassiveOpen;
  3332.                 fNTE := Pointer(NewPtr(sizeof(NamesTableEntry)));
  3333.                 FailNil(fNTE);
  3334.                 s := GetString(kChooserName)^^;
  3335.                 NBPSetNTE(Ptr(fNTE),s,kLACS,'*',fADSPSocket);
  3336.                 with pBlock do
  3337.                     begin
  3338.                         interval := kNBPTimeOutVal;
  3339.                         count := kNBPRetryCount;
  3340.                         entityPtr := Ptr(fNTE);
  3341.                         verifyFlag := 1;
  3342.                     end;
  3343.                 FailOSErr(PRegisterName(@pBlock,false));
  3344.             end;
  3345.     end;
  3346.  
  3347. {--------------------------------------------------------------------------------------------------}
  3348.  
  3349. {$S ARes}
  3350.  
  3351. procedure TGossip.PassiveOpen;
  3352.     { Do a passive connection open. }
  3353.  
  3354.     var ignore: OSErr;
  3355.  
  3356.     begin
  3357.         { Build an ADSP passive open request. }
  3358.         with fADSP^ do
  3359.             begin
  3360.                 { Issue a passive open command. }
  3361.                 ioCompletion := nil;
  3362.                 filterAddress := AddrBlock(0);
  3363.                 ocMode := ocPassive;
  3364.                 ocInterval := 0;
  3365.                 ocMaximum := 0;
  3366.                 csCode := dspOpen;
  3367.             end;
  3368.         { Open it. }
  3369.         ignore := PBControl(ParmBlkPtr(fADSP),true);
  3370.         fState := kPeriodicWaiting;
  3371.     end;
  3372.  
  3373. {--------------------------------------------------------------------------------------------------}
  3374.  
  3375. {$S ARes}
  3376.  
  3377. procedure TGossip.ResetConnection;
  3378.     { Reset the connection. }
  3379.  
  3380.     var ignore: OSErr;
  3381.  
  3382.     begin
  3383.         { Build an ADSP close connection request. }
  3384.         with fADSP^ do
  3385.             begin
  3386.                 abort := 0;
  3387.                 csCode := dspClose;
  3388.             end;
  3389.         { Close the connection. }
  3390.         ignore := PBControl(ParmBlkPtr(fADSP),false);
  3391.         { Then reopen a listen if we're doing input, or reset to timing out if we're doing output. }
  3392.         if not fOutgoing then PassiveOpen
  3393.         else fState := kPeriodicInactive;
  3394.     end;
  3395.  
  3396. {--------------------------------------------------------------------------------------------------}
  3397.  
  3398. {$S ARes}
  3399.  
  3400. procedure TGossip.Waiting;
  3401.     { Wait for more input or a connection to open. }
  3402.  
  3403.     var ignore: OSErr;
  3404.  
  3405.     begin
  3406.         { We've got something if the operation has completed, and it isn't a zero-length read. }
  3407.         if (fADSP^.ioResult = noErr) and ((fADSP^.csCode <> dspRead) or (fADSP^.actCount <> 0)) then
  3408.             begin
  3409.                 if not fOutgoing then fDocument.fStatusWindow.SetStatus(kStatIncomingConnect);
  3410.                 fState := kPeriodicActive;
  3411.             end
  3412.         else if fADSP^.ioResult <= noErr then ResetConnection;
  3413.     end;
  3414.  
  3415.